Changeset 2930
- Timestamp:
- Mar 23, 2018 4:30:46 PM (7 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
netcdf_data_input_mod.f90 (modified) (4 diffs)
-
radiation_model_mod.f90 (modified) (55 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r2925 r2930 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Revise checks for surface_fraction. 28 ! 29 ! 2925 2018-03-23 14:54:11Z suehring 27 30 ! Check for further inconsistent settings of surface_fractions. 28 31 ! Some messages slightly rephrased and error numbers renamed. … … 2785 2788 INTEGER(iwp) :: i !< loop index along x-direction 2786 2789 INTEGER(iwp) :: j !< loop index along y-direction 2790 INTEGER(iwp) :: n_surf !< number of different surface types at given location 2787 2791 2788 2792 LOGICAL :: check_passed !< flag indicating if a check passed … … 2991 2995 ENDIF 2992 2996 ! 2993 !-- Check for consistency of surface fraction. 2994 !-- Sum of surface fractions must not exceed one. 2995 IF ( ANY ( surface_fraction_f%frac(:,j,i) == & 2996 surface_fraction_f%fill ) ) THEN 2997 message_string = 'If more than one natural surface type is ' //& 2998 'given at a location, surface_fraction ' // & 2999 'must be provided.' 3000 CALL message( 'netcdf_data_input_mod', 'NDI027', & 2997 !-- Check for consistency of surface fraction. If more than one type 2998 !-- is set, surface fraction need to be given and the sum must not 2999 !-- be larger than 1. 3000 n_surf = 0 3001 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & 3002 n_surf = n_surf + 1 3003 IF ( water_type_f%var(j,i) /= water_type_f%fill ) & 3004 n_surf = n_surf + 1 3005 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) & 3006 n_surf = n_surf + 1 3007 3008 IF ( n_surf > 1 ) THEN 3009 IF ( ANY ( surface_fraction_f%frac(:,j,i) == & 3010 surface_fraction_f%fill ) ) THEN 3011 message_string = 'If more than one surface type is ' // & 3012 'given at a location, surface_fraction ' // & 3013 'must be provided.' 3014 CALL message( 'netcdf_data_input_mod', 'NDI027', & 3001 3015 2, 2, 0, 6, 0 ) 3002 ENDIF 3003 IF ( SUM ( surface_fraction_f%frac(:,j,i) ) > 1.0_wp ) THEN 3004 message_string = 'surface_fraction must not exceed 1' 3005 CALL message( 'netcdf_data_input_mod', 'NDI028', & 3006 2, 2, 0, 6, 0 ) 3016 ENDIF 3017 IF ( SUM ( surface_fraction_f%frac(:,j,i) ) > 1.0_wp ) THEN 3018 message_string = 'surface_fraction must not exceed 1' 3019 CALL message( 'netcdf_data_input_mod', 'NDI028', & 3020 2, 2, 0, 6, 0 ) 3021 ENDIF 3007 3022 ENDIF 3008 3023 ! 3009 3024 !-- Check for further mismatches, e.g. vegetation_type is set but 3010 3025 !-- surface vegetation fraction is zero. 3011 IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .AND. & 3012 surface_fraction_f%frac(0,j,i) == 0.0_wp ) .OR. & 3013 ( pavement_type_f%var(j,i) /= pavement_type_f%fill .AND. & 3014 surface_fraction_f%frac(1,j,i) == 0.0_wp ) .OR. & 3015 ( water_type_f%var(j,i) /= water_type_f%fill .AND. & 3016 surface_fraction_f%frac(2,j,i) == 0.0_wp ) ) THEN 3017 WRITE( message_string, * ) 'Mismatch in setting of ' // & 3018 'surface_fraction. Vegetation-, pavement-, or '// & 3019 'water surface is given at (i,j) = ( ', i, j, & 3020 ' ), but surface fraction is 0 for the given type.' 3021 CALL message( 'netcdf_data_input_mod', 'NDI029', & 3026 IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .AND.& 3027 ( surface_fraction_f%frac(0,j,i) == 0.0_wp .OR. & 3028 surface_fraction_f%frac(0,j,i) == surface_fraction_f%fill ) & 3029 ) .OR. & 3030 ( pavement_type_f%var(j,i) /= pavement_type_f%fill .AND. & 3031 ( surface_fraction_f%frac(1,j,i) == 0.0_wp .OR. & 3032 surface_fraction_f%frac(1,j,i) == surface_fraction_f%fill ) & 3033 ) .OR. & 3034 ( water_type_f%var(j,i) /= water_type_f%fill .AND. & 3035 ( surface_fraction_f%frac(2,j,i) == 0.0_wp .OR. & 3036 surface_fraction_f%frac(2,j,i) == surface_fraction_f%fill ) & 3037 ) ) THEN 3038 WRITE( message_string, * ) 'Mismatch in setting of ' // & 3039 'surface_fraction. Vegetation-, pavement-, or '// & 3040 'water surface is given at (i,j) = ( ', i, j, & 3041 ' ), but surface fraction is 0 for the given type.' 3042 CALL message( 'netcdf_data_input_mod', 'NDI029', & 3022 3043 2, 2, 0, 6, 0 ) 3023 3044 ENDIF … … 3025 3046 !-- Check for further mismatches, e.g. vegetation_type is not set 3026 3047 !-- surface vegetation fraction is non-zero. 3027 IF ( ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND. & 3028 surface_fraction_f%frac(0,j,i) /= 0.0_wp ) .OR. & 3029 ( pavement_type_f%var(j,i) == pavement_type_f%fill .AND. & 3030 surface_fraction_f%frac(1,j,i) /= 0.0_wp ) .OR. & 3031 ( water_type_f%var(j,i) == water_type_f%fill .AND. & 3032 surface_fraction_f%frac(2,j,i) /= 0.0_wp ) ) THEN 3033 WRITE( message_string, * ) 'Mismatch in setting of ' // & 3034 'surface_fraction. Vegetation-, pavement-, or '// & 3035 'water surface is not given at (i,j) = ( ', i, j, & 3036 ' ), but surface fraction is not 0 for the ' // & 3037 'given type.' 3038 CALL message( 'netcdf_data_input_mod', 'NDI030', & 3048 IF ( ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND.& 3049 ( surface_fraction_f%frac(0,j,i) /= 0.0_wp .AND. & 3050 surface_fraction_f%frac(0,j,i) /= surface_fraction_f%fill ) & 3051 ) .OR. & 3052 ( pavement_type_f%var(j,i) == pavement_type_f%fill .AND. & 3053 ( surface_fraction_f%frac(1,j,i) /= 0.0_wp .AND. & 3054 surface_fraction_f%frac(1,j,i) /= surface_fraction_f%fill ) & 3055 ) .OR. & 3056 ( water_type_f%var(j,i) == water_type_f%fill .AND. & 3057 ( surface_fraction_f%frac(2,j,i) /= 0.0_wp .AND. & 3058 surface_fraction_f%frac(2,j,i) /= surface_fraction_f%fill ) & 3059 ) ) THEN 3060 WRITE( message_string, * ) 'Mismatch in setting of ' // & 3061 'surface_fraction. Vegetation-, pavement-, or '// & 3062 'water surface is not given at (i,j) = ( ', i, j, & 3063 ' ), but surface fraction is not 0 for the ' // & 3064 'given type.' 3065 CALL message( 'netcdf_data_input_mod', 'NDI030', & 3039 3066 2, 2, 0, 6, 0 ) 3040 3067 ENDIF -
palm/trunk/SOURCE/radiation_model_mod.f90
r2920 r2930 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Remove default surfaces from radiation model, does not make much sense to 31 ! apply radiation model without energy-balance solvers; Further, add check for 32 ! this. 33 ! 34 ! 2920 2018-03-22 11:22:01Z kanani 30 35 ! - Bugfix: Initialize pcbl array (=-1) 31 36 ! moh.hefny: … … 344 349 USE surface_mod, & 345 350 ONLY: get_topography_top_index, get_topography_top_index_ji, & 346 surf_def_h, surf_def_v, surf_lsm_h, & 347 surf_lsm_v, surf_type, surf_usm_h, surf_usm_v 351 surf_lsm_h, surf_lsm_v, surf_type, surf_usm_h, surf_usm_v 348 352 349 353 IMPLICIT NONE … … 1219 1223 1220 1224 USE control_parameters, & 1221 ONLY: message_string, topography, urban_surface1225 ONLY: land_surface, message_string, topography, urban_surface 1222 1226 1223 1227 USE netcdf_data_input_mod, & … … 1226 1230 IMPLICIT NONE 1227 1231 1232 ! 1233 !-- In case no urban-surface or land-surface model is applied, usage of 1234 !-- a radiation model make no sense. 1235 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 1236 message_string = 'Usage of radiation module is only allowed if ' // & 1237 'land-surface and/or urban-surface model is applied.' 1238 CALL message( 'check_parameters', 'PA0486', 1, 2, 0, 6, 0 ) 1239 ENDIF 1228 1240 1229 1241 IF ( radiation_scheme /= 'constant' .AND. & … … 1316 1328 ! 1317 1329 !-- Allocate array for storing the surface net radiation 1318 IF ( .NOT. ALLOCATED ( surf_def_h(0)%rad_net ) .AND. &1319 surf_def_h(0)%ns > 0 ) THEN1320 ALLOCATE( surf_def_h(0)%rad_net(1:surf_def_h(0)%ns) )1321 surf_def_h(0)%rad_net = 0.0_wp1322 ENDIF1323 1330 IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_net ) .AND. & 1324 1331 surf_lsm_h%ns > 0 ) THEN … … 1332 1339 ENDIF 1333 1340 DO l = 0, 3 1334 IF ( .NOT. ALLOCATED ( surf_def_v(l)%rad_net ) .AND. &1335 surf_def_v(l)%ns > 0 ) THEN1336 ALLOCATE( surf_def_v(l)%rad_net(1:surf_def_v(l)%ns) )1337 surf_def_v(l)%rad_net = 0.0_wp1338 ENDIF1339 1341 IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_net ) .AND. & 1340 1342 surf_lsm_v(l)%ns > 0 ) THEN … … 1352 1354 ! 1353 1355 !-- Allocate array for storing the surface longwave (out) radiation change 1354 IF ( .NOT. ALLOCATED ( surf_def_h(0)%rad_lw_out_change_0 ) .AND. &1355 surf_def_h(0)%ns > 0 ) THEN1356 ALLOCATE( surf_def_h(0)%rad_lw_out_change_0(1:surf_def_h(0)%ns) )1357 surf_def_h(0)%rad_lw_out_change_0 = 0.0_wp1358 ENDIF1359 1356 IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_lw_out_change_0 ) .AND. & 1360 1357 surf_lsm_h%ns > 0 ) THEN … … 1368 1365 ENDIF 1369 1366 DO l = 0, 3 1370 IF ( .NOT. ALLOCATED ( surf_def_v(l)%rad_lw_out_change_0 ) .AND. &1371 surf_def_v(l)%ns > 0 ) THEN1372 ALLOCATE( surf_def_v(l)%rad_lw_out_change_0(1:surf_def_v(l)%ns) )1373 surf_def_v(l)%rad_lw_out_change_0 = 0.0_wp1374 ENDIF1375 1367 IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_lw_out_change_0 ) .AND. & 1376 1368 surf_lsm_v(l)%ns > 0 ) THEN … … 1387 1379 ! 1388 1380 !-- Allocate surface arrays for incoming/outgoing short/longwave radiation 1389 IF ( .NOT. ALLOCATED ( surf_def_h(0)%rad_sw_in ) .AND. &1390 surf_def_h(0)%ns > 0 ) THEN1391 ALLOCATE( surf_def_h(0)%rad_sw_in(1:surf_def_h(0)%ns) )1392 ALLOCATE( surf_def_h(0)%rad_sw_out(1:surf_def_h(0)%ns) )1393 ALLOCATE( surf_def_h(0)%rad_lw_in(1:surf_def_h(0)%ns) )1394 ALLOCATE( surf_def_h(0)%rad_lw_out(1:surf_def_h(0)%ns) )1395 surf_def_h(0)%rad_sw_in = 0.0_wp1396 surf_def_h(0)%rad_sw_out = 0.0_wp1397 surf_def_h(0)%rad_lw_in = 0.0_wp1398 surf_def_h(0)%rad_lw_out = 0.0_wp1399 ENDIF1400 1381 IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_sw_in ) .AND. & 1401 1382 surf_lsm_h%ns > 0 ) THEN … … 1421 1402 ENDIF 1422 1403 DO l = 0, 3 1423 IF ( .NOT. ALLOCATED ( surf_def_v(l)%rad_sw_in ) .AND. &1424 surf_def_v(l)%ns > 0 ) THEN1425 ALLOCATE( surf_def_v(l)%rad_sw_in(1:surf_def_v(l)%ns) )1426 ALLOCATE( surf_def_v(l)%rad_sw_out(1:surf_def_v(l)%ns) )1427 ALLOCATE( surf_def_v(l)%rad_lw_in(1:surf_def_v(l)%ns) )1428 ALLOCATE( surf_def_v(l)%rad_lw_out(1:surf_def_v(l)%ns) )1429 surf_def_v(l)%rad_sw_in = 0.0_wp1430 surf_def_v(l)%rad_sw_out = 0.0_wp1431 surf_def_v(l)%rad_lw_in = 0.0_wp1432 surf_def_v(l)%rad_lw_out = 0.0_wp1433 ENDIF1434 1404 IF ( .NOT. ALLOCATED ( surf_lsm_v(l)%rad_sw_in ) .AND. & 1435 1405 surf_lsm_v(l)%ns > 0 ) THEN … … 1456 1426 ENDDO 1457 1427 ! 1458 !-- If necessary, allocate surface attribute albedo_type.1459 !-- Only for default-surfaces, In case urban- or land-surface scheme is1460 !-- utilized, this has been already allocated. For default surfaces,1461 !-- no tile approach between different surface fractions is considered,1462 !-- so first dimension is allocated with zero.1463 !-- Initialize them with namelist parameter.1464 ALLOCATE ( surf_def_h(0)%albedo_type(0:0,1:surf_def_h(0)%ns) )1465 surf_def_h(0)%albedo_type = albedo_type1466 1467 DO l = 0, 31468 ALLOCATE ( surf_def_v(l)%albedo_type(0:0,1:surf_def_v(l)%ns) )1469 surf_def_v(l)%albedo_type = albedo_type1470 ENDDO1471 !1472 !-- If available, overwrite albedo_type by values read from file.1473 !-- Again, only required for default-type surfaces.1474 IF ( albedo_type_f%from_file ) THEN1475 DO i = nxl, nxr1476 DO j = nys, nyn1477 IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill ) THEN1478 1479 DO m = surf_def_h(0)%start_index(j,i), &1480 surf_def_h(0)%end_index(j,i)1481 surf_def_h(0)%albedo_type(0,m) = albedo_type_f%var(j,i)1482 ENDDO1483 DO l = 0, 31484 ioff = surf_def_v(l)%ioff1485 joff = surf_def_v(l)%joff1486 DO m = surf_def_v(l)%start_index(j,i), &1487 surf_def_v(l)%end_index(j,i)1488 surf_def_v(l)%albedo_type(0,m) = &1489 albedo_type_f%var(j+joff,i+ioff)1490 ENDDO1491 ENDDO1492 ENDIF1493 ENDDO1494 ENDDO1495 ENDIF1496 1497 !1498 !-- If necessary, allocate surface attribute emissivity.1499 !-- Only for default-type surfaces. In case urband- or1500 !-- land-surface scheme is utilized, this has been already allocated.1501 !-- Initialize them with namelist parameter.1502 ALLOCATE ( surf_def_h(0)%emissivity(0:0,1:surf_def_h(0)%ns) )1503 surf_def_h(0)%emissivity = emissivity1504 1505 DO l = 0, 31506 ALLOCATE ( surf_def_v(l)%emissivity(0:0,1:surf_def_v(l)%ns) )1507 ENDDO1508 1509 !1510 1428 !-- Fix net radiation in case of radiation_scheme = 'constant' 1511 1429 IF ( radiation_scheme == 'constant' ) THEN 1512 IF ( ALLOCATED( surf_def_h(0)%rad_net ) ) &1513 surf_def_h(0)%rad_net = net_radiation1514 1430 IF ( ALLOCATED( surf_lsm_h%rad_net ) ) & 1515 1431 surf_lsm_h%rad_net = net_radiation … … 1519 1435 !-- Todo: weight with inclination angle 1520 1436 DO l = 0, 3 1521 IF ( ALLOCATED( surf_def_v(l)%rad_net ) ) &1522 surf_def_v(l)%rad_net = net_radiation1523 1437 IF ( ALLOCATED( surf_lsm_v(l)%rad_net ) ) & 1524 1438 surf_lsm_v(l)%rad_net = net_radiation … … 1575 1489 !-- Allocate arrays for broadband albedo, and level 1 initialization 1576 1490 !-- via namelist paramter, unless already allocated. 1577 IF ( .NOT. ALLOCATED(surf_def_h(0)%albedo) ) THEN1578 ALLOCATE( surf_def_h(0)%albedo(0:0,1:surf_def_h(0)%ns) )1579 surf_def_h(0)%albedo = albedo1580 ENDIF1581 1491 IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) ) THEN 1582 1492 ALLOCATE( surf_lsm_h%albedo(0:2,1:surf_lsm_h%ns) ) … … 1589 1499 1590 1500 DO l = 0, 3 1591 IF ( .NOT. ALLOCATED( surf_def_v(l)%albedo ) ) THEN1592 ALLOCATE( surf_def_v(l)%albedo(0:0,1:surf_def_v(l)%ns) )1593 surf_def_v(l)%albedo = albedo1594 ENDIF1595 1501 IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) ) THEN 1596 1502 ALLOCATE( surf_lsm_v(l)%albedo(0:2,1:surf_lsm_v(l)%ns) ) … … 1605 1511 !-- Level 2 initialization of broadband albedo via given albedo_type. 1606 1512 !-- Only if albedo_type is non-zero 1607 DO m = 1, surf_def_h(0)%ns1608 IF ( surf_def_h(0)%albedo_type(0,m) /= 0 ) &1609 surf_def_h(0)%albedo(0,m) = &1610 albedo_pars(2,surf_def_h(0)%albedo_type(0,m))1611 ENDDO1612 1513 DO m = 1, surf_lsm_h%ns 1613 1514 IF ( surf_lsm_h%albedo_type(0,m) /= 0 ) & … … 1634 1535 1635 1536 DO l = 0, 3 1636 DO m = 1, surf_def_v(l)%ns1637 IF ( surf_def_v(l)%albedo_type(0,m) /= 0 ) &1638 surf_def_v(l)%albedo(0,m) = &1639 albedo_pars(2,surf_def_v(l)%albedo_type(0,m))1640 ENDDO1641 1537 DO m = 1, surf_lsm_v(l)%ns 1642 1538 IF ( surf_lsm_v(l)%albedo_type(0,m) /= 0 ) & … … 1670 1566 ! 1671 1567 !-- Horizontal surfaces 1672 DO m = 1, surf_def_h(0)%ns1673 i = surf_def_h(0)%i(m)1674 j = surf_def_h(0)%j(m)1675 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill .AND. &1676 surf_def_h(0)%albedo_type(0,m) == 0 ) THEN1677 surf_def_h(0)%albedo(0,m) = albedo_pars_f%pars_xy(0,j,i)1678 ENDIF1679 ENDDO1680 1568 DO m = 1, surf_lsm_h%ns 1681 1569 i = surf_lsm_h%i(m) … … 1706 1594 DO l = 0, 3 1707 1595 1708 ioff = surf_def_v(l)%ioff1709 joff = surf_def_v(l)%joff1710 DO m = 1, surf_def_v(l)%ns1711 i = surf_def_v(l)%i(m) + ioff1712 j = surf_def_v(l)%j(m) + joff1713 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill .AND. &1714 surf_def_v(l)%albedo_type(0,m) == 0 ) THEN1715 surf_def_v(l)%albedo(0,m) = albedo_pars_f%pars_xy(0,j,i)1716 ENDIF1717 ENDDO1718 1719 1596 ioff = surf_lsm_v(l)%ioff 1720 1597 joff = surf_lsm_v(l)%joff … … 1756 1633 !-- Allocate albedos for short/longwave radiation, horizontal surfaces 1757 1634 !-- for wall/green/window (USM) or vegetation/pavement/water surfaces 1758 !-- (LSM). Please note, for default-type surfaces no tile approach is 1759 !-- applied. 1760 ALLOCATE ( surf_def_h(0)%aldif(0:0,1:surf_def_h(0)%ns) ) 1761 ALLOCATE ( surf_def_h(0)%aldir(0:0,1:surf_def_h(0)%ns) ) 1762 ALLOCATE ( surf_def_h(0)%asdif(0:0,1:surf_def_h(0)%ns) ) 1763 ALLOCATE ( surf_def_h(0)%asdir(0:0,1:surf_def_h(0)%ns) ) 1764 ALLOCATE ( surf_def_h(0)%rrtm_aldif(0:0,1:surf_def_h(0)%ns) ) 1765 ALLOCATE ( surf_def_h(0)%rrtm_aldir(0:0,1:surf_def_h(0)%ns) ) 1766 ALLOCATE ( surf_def_h(0)%rrtm_asdif(0:0,1:surf_def_h(0)%ns) ) 1767 ALLOCATE ( surf_def_h(0)%rrtm_asdir(0:0,1:surf_def_h(0)%ns) ) 1768 1635 !-- (LSM). 1769 1636 ALLOCATE ( surf_lsm_h%aldif(0:2,1:surf_lsm_h%ns) ) 1770 1637 ALLOCATE ( surf_lsm_h%aldir(0:2,1:surf_lsm_h%ns) ) … … 1788 1655 !-- Allocate broadband albedo (temporary for the current radiation 1789 1656 !-- implementations) 1790 IF ( .NOT. ALLOCATED(surf_def_h(0)%albedo) ) &1791 ALLOCATE( surf_def_h(0)%albedo(0:0,1:surf_def_h(0)%ns) )1792 1657 IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) ) & 1793 1658 ALLOCATE( surf_lsm_h%albedo(0:2,1:surf_lsm_h%ns) ) … … 1798 1663 !-- Allocate albedos for short/longwave radiation, vertical surfaces 1799 1664 DO l = 0, 3 1800 ALLOCATE ( surf_def_v(l)%aldif(0:0,1:surf_def_v(l)%ns) )1801 ALLOCATE ( surf_def_v(l)%aldir(0:0,1:surf_def_v(l)%ns) )1802 ALLOCATE ( surf_def_v(l)%asdif(0:0,1:surf_def_v(l)%ns) )1803 ALLOCATE ( surf_def_v(l)%asdir(0:0,1:surf_def_v(l)%ns) )1804 1805 ALLOCATE ( surf_def_v(l)%rrtm_aldif(0:0,1:surf_def_v(l)%ns) )1806 ALLOCATE ( surf_def_v(l)%rrtm_aldir(0:0,1:surf_def_v(l)%ns) )1807 ALLOCATE ( surf_def_v(l)%rrtm_asdif(0:0,1:surf_def_v(l)%ns) )1808 ALLOCATE ( surf_def_v(l)%rrtm_asdir(0:0,1:surf_def_v(l)%ns) )1809 1665 1810 1666 ALLOCATE ( surf_lsm_v(l)%aldif(0:2,1:surf_lsm_v(l)%ns) ) … … 1830 1686 !-- Allocate broadband albedo (temporary for the current radiation 1831 1687 !-- implementations) 1832 IF ( .NOT. ALLOCATED( surf_def_v(l)%albedo ) ) &1833 ALLOCATE( surf_def_v(l)%albedo(0:0,1:surf_def_v(l)%ns) )1834 1688 IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) ) & 1835 1689 ALLOCATE( surf_lsm_v(l)%albedo(0:2,1:surf_lsm_v(l)%ns) ) … … 1842 1696 !-- paramters. Please note, this case all surface tiles are initialized 1843 1697 !-- the same. 1844 IF ( surf_def_h(0)%ns > 0 ) THEN1845 surf_def_h(0)%aldif = albedo_lw_dif1846 surf_def_h(0)%aldir = albedo_lw_dir1847 surf_def_h(0)%asdif = albedo_sw_dif1848 surf_def_h(0)%asdir = albedo_sw_dir1849 surf_def_h(0)%albedo = albedo_sw_dif1850 ENDIF1851 1698 IF ( surf_lsm_h%ns > 0 ) THEN 1852 1699 surf_lsm_h%aldif = albedo_lw_dif … … 1865 1712 1866 1713 DO l = 0, 3 1867 IF ( surf_def_v(l)%ns > 0 ) THEN1868 surf_def_v(l)%aldif = albedo_lw_dif1869 surf_def_v(l)%aldir = albedo_lw_dir1870 surf_def_v(l)%asdif = albedo_sw_dif1871 surf_def_v(l)%asdir = albedo_sw_dir1872 surf_def_v(l)%albedo = albedo_sw_dif1873 ENDIF1874 1714 1875 1715 IF ( surf_lsm_v(l)%ns > 0 ) THEN … … 1895 1735 !-- is applied so that the resulting albedo is calculated via the weighted 1896 1736 !-- average of respective surface fractions. 1897 DO m = 1, surf_def_h(0)%ns1898 IF ( surf_def_h(0)%albedo_type(0,m) /= 0 ) THEN1899 surf_def_h(0)%aldif(0,m) = &1900 albedo_pars(0,surf_def_h(0)%albedo_type(0,m))1901 surf_def_h(0)%asdif(0,m) = &1902 albedo_pars(1,surf_def_h(0)%albedo_type(0,m))1903 surf_def_h(0)%aldir(0,m) = &1904 albedo_pars(0,surf_def_h(0)%albedo_type(0,m))1905 surf_def_h(0)%asdir(0,m) = &1906 albedo_pars(1,surf_def_h(0)%albedo_type(0,m))1907 surf_def_h(0)%albedo(0,m) = &1908 albedo_pars(2,surf_def_h(0)%albedo_type(0,m))1909 ENDIF1910 ENDDO1911 1912 1737 DO m = 1, surf_lsm_h%ns 1913 1738 ! … … 1951 1776 1952 1777 DO l = 0, 3 1953 1954 DO m = 1, surf_def_v(l)%ns1955 IF ( surf_def_v(l)%albedo_type(0,m) /= 0 ) THEN1956 surf_def_v(l)%aldif(0,m) = &1957 albedo_pars(0,surf_def_v(l)%albedo_type(0,m))1958 surf_def_v(l)%asdif(0,m) = &1959 albedo_pars(1,surf_def_v(l)%albedo_type(0,m))1960 surf_def_v(l)%aldir(0,m) = &1961 albedo_pars(0,surf_def_v(l)%albedo_type(0,m))1962 surf_def_v(l)%asdir(0,m) = &1963 albedo_pars(1,surf_def_v(l)%albedo_type(0,m))1964 surf_def_v(l)%albedo(0,m) = &1965 albedo_pars(2,surf_def_v(l)%albedo_type(0,m))1966 ENDIF1967 ENDDO1968 1778 1969 1779 DO m = 1, surf_lsm_v(l)%ns … … 2012 1822 ! 2013 1823 !-- Horizontal 2014 DO m = 1, surf_def_h(0)%ns2015 i = surf_def_h(0)%i(m)2016 j = surf_def_h(0)%j(m)2017 IF ( surf_def_h(0)%albedo_type(0,m) == 0 ) THEN2018 2019 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) &2020 surf_def_h(0)%albedo(0,m) = albedo_pars_f%pars_xy(1,j,i)2021 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) &2022 surf_def_h(0)%aldir(0,m) = albedo_pars_f%pars_xy(1,j,i)2023 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) &2024 surf_def_h(0)%aldif(0,m) = albedo_pars_f%pars_xy(2,j,i)2025 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) &2026 surf_def_h(0)%asdir(0,m) = albedo_pars_f%pars_xy(3,j,i)2027 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) &2028 surf_def_h(0)%asdif(0,m) = albedo_pars_f%pars_xy(4,j,i)2029 ENDIF2030 ENDDO2031 2032 1824 DO m = 1, surf_lsm_h%ns 2033 1825 i = surf_lsm_h%i(m) … … 2085 1877 !-- Vertical 2086 1878 DO l = 0, 3 2087 ioff = surf_def_v(l)%ioff2088 joff = surf_def_v(l)%joff2089 2090 DO m = 1, surf_def_v(l)%ns2091 2092 i = surf_def_v(l)%i(m)2093 j = surf_def_v(l)%j(m)2094 2095 IF ( surf_def_v(l)%albedo_type(0,m) == 0 ) THEN2096 2097 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= &2098 albedo_pars_f%fill ) &2099 surf_def_v(l)%albedo(0,m) = &2100 albedo_pars_f%pars_xy(1,j+joff,i+ioff)2101 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= &2102 albedo_pars_f%fill ) &2103 surf_def_v(l)%aldir(0,m) = &2104 albedo_pars_f%pars_xy(1,j+joff,i+ioff)2105 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= &2106 albedo_pars_f%fill ) &2107 surf_def_v(l)%aldif(0,m) = &2108 albedo_pars_f%pars_xy(2,j+joff,i+ioff)2109 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= &2110 albedo_pars_f%fill ) &2111 surf_def_v(l)%asdir(0,m) = &2112 albedo_pars_f%pars_xy(3,j+joff,i+ioff)2113 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= &2114 albedo_pars_f%fill ) &2115 surf_def_v(l)%asdif(0,m) = &2116 albedo_pars_f%pars_xy(4,j+joff,i+ioff)2117 ENDIF2118 ENDDO2119 2120 1879 ioff = surf_lsm_v(l)%ioff 2121 1880 joff = surf_lsm_v(l)%joff … … 2198 1957 IF ( .NOT. constant_albedo ) THEN 2199 1958 ! 2200 !-- Horizontally aligned default, natural and urban surfaces 2201 CALL calc_albedo( surf_def_h(0) ) 1959 !-- Horizontally aligned natural and urban surfaces 2202 1960 CALL calc_albedo( surf_lsm_h ) 2203 1961 CALL calc_albedo( surf_usm_h ) 2204 1962 ! 2205 !-- Vertically aligned default,natural and urban surfaces1963 !-- Vertically aligned natural and urban surfaces 2206 1964 DO l = 0, 3 2207 CALL calc_albedo( surf_def_v(l) )2208 1965 CALL calc_albedo( surf_lsm_v(l) ) 2209 1966 CALL calc_albedo( surf_usm_v(l) ) … … 2213 1970 !-- Initialize sun-inclination independent spectral albedos 2214 1971 !-- Horizontal surfaces 2215 IF ( surf_def_h(0)%ns > 0 ) THEN2216 surf_def_h(0)%rrtm_aldir = surf_def_h(0)%aldir2217 surf_def_h(0)%rrtm_asdir = surf_def_h(0)%asdir2218 surf_def_h(0)%rrtm_aldif = surf_def_h(0)%aldif2219 surf_def_h(0)%rrtm_asdif = surf_def_h(0)%asdif2220 ENDIF2221 1972 IF ( surf_lsm_h%ns > 0 ) THEN 2222 1973 surf_lsm_h%rrtm_aldir = surf_lsm_h%aldir … … 2234 1985 !-- Vertical surfaces 2235 1986 DO l = 0, 3 2236 IF ( surf_def_h(0)%ns > 0 ) THEN2237 surf_def_v(l)%rrtm_aldir = surf_def_v(l)%aldir2238 surf_def_v(l)%rrtm_asdir = surf_def_v(l)%asdir2239 surf_def_v(l)%rrtm_aldif = surf_def_v(l)%aldif2240 surf_def_v(l)%rrtm_asdif = surf_def_v(l)%asdif2241 ENDIF2242 1987 IF ( surf_lsm_v(l)%ns > 0 ) THEN 2243 1988 surf_lsm_v(l)%rrtm_aldir = surf_lsm_v(l)%aldir … … 2464 2209 !-- Call clear-sky calculation for each surface orientation. 2465 2210 !-- First, horizontal surfaces 2466 surf => surf_def_h(0)2467 CALL radiation_clearsky_surf2468 2211 surf => surf_lsm_h 2469 2212 CALL radiation_clearsky_surf … … 2473 2216 !-- Vertical surfaces 2474 2217 DO l = 0, 3 2475 surf => surf_def_v(l)2476 CALL radiation_clearsky_surf2477 2218 surf => surf_lsm_v(l) 2478 2219 CALL radiation_clearsky_surf … … 2532 2273 ! 2533 2274 !-- Weighted average according to surface fraction. 2534 !-- In case no surface fraction is given ( default-type )2535 !-- no weighted averaging is performed ( only one surface type per2536 !-- surface element ).2537 2275 !-- ATTENTION: when radiation interactions are switched on the 2538 2276 !-- calculated fluxes below are not actually used as they are 2539 2277 !-- overwritten in radiation_interaction. 2540 IF ( ALLOCATED( surf%frac ) ) THEN 2541 2542 surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m) & 2543 + surf%frac(1,m) * surf%albedo(1,m) & 2544 + surf%frac(2,m) * surf%albedo(2,m) ) & 2545 * surf%rad_sw_in(m) 2546 2547 surf%rad_lw_out(m) = ( surf%frac(0,m) * surf%emissivity(0,m)& 2548 + surf%frac(1,m) * surf%emissivity(1,m)& 2549 + surf%frac(2,m) * surf%emissivity(2,m)& 2550 ) & 2551 * sigma_sb & 2552 * ( surf%pt_surface(m) * exn )**4 2553 2554 surf%rad_lw_out_change_0(m) = & 2555 ( surf%frac(0,m) * surf%emissivity(0,m) & 2556 + surf%frac(1,m) * surf%emissivity(1,m) & 2557 + surf%frac(2,m) * surf%emissivity(2,m) & 2558 ) * 3.0_wp * sigma_sb & 2559 * ( surf%pt_surface(m) * exn )** 3 2560 2561 ELSE 2562 2563 surf%rad_sw_out(m) = surf%albedo(0,m) * surf%rad_sw_in(m) 2564 2565 surf%rad_lw_out(m) = surf%emissivity(0,m) & 2566 * sigma_sb & 2567 * ( surf%pt_surface(m) * exn )**4 2568 2569 surf%rad_lw_out_change_0(m) = surf%emissivity(0,m) & 2570 * 3.0_wp * sigma_sb & 2571 * ( surf%pt_surface(m) * exn )** 3 2572 2573 ENDIF 2278 surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m) & 2279 + surf%frac(1,m) * surf%albedo(1,m) & 2280 + surf%frac(2,m) * surf%albedo(2,m) ) & 2281 * surf%rad_sw_in(m) 2282 2283 surf%rad_lw_out(m) = ( surf%frac(0,m) * surf%emissivity(0,m)& 2284 + surf%frac(1,m) * surf%emissivity(1,m)& 2285 + surf%frac(2,m) * surf%emissivity(2,m)& 2286 ) & 2287 * sigma_sb & 2288 * ( surf%pt_surface(m) * exn )**4 2289 2290 surf%rad_lw_out_change_0(m) = & 2291 ( surf%frac(0,m) * surf%emissivity(0,m) & 2292 + surf%frac(1,m) * surf%emissivity(1,m) & 2293 + surf%frac(2,m) * surf%emissivity(2,m) & 2294 ) * 3.0_wp * sigma_sb & 2295 * ( surf%pt_surface(m) * exn )** 3 2296 2574 2297 2575 2298 IF ( cloud_physics ) THEN … … 2580 2303 ENDIF 2581 2304 2582 surf%rad_net(m) = surf%rad_sw_in(m) - surf%rad_sw_out(m) 2305 surf%rad_net(m) = surf%rad_sw_in(m) - surf%rad_sw_out(m) & 2583 2306 + surf%rad_lw_in(m) - surf%rad_lw_out(m) 2584 2307 … … 2654 2377 ! 2655 2378 !-- First, horizontal surfaces 2656 surf => surf_def_h(0)2657 CALL radiation_constant_surf2658 2379 surf => surf_lsm_h 2659 2380 CALL radiation_constant_surf … … 2663 2384 !-- Vertical surfaces 2664 2385 DO l = 0, 3 2665 surf => surf_def_v(l)2666 CALL radiation_constant_surf2667 2386 surf => surf_lsm_v(l) 2668 2387 CALL radiation_constant_surf … … 2737 2456 surf%rad_lw_in(m) = 0.8_wp * sigma_sb * (pt1 * exn1)**4 2738 2457 ELSE 2739 surf%rad_lw_in(m) = 0.8_wp * sigma_sb * 2458 surf%rad_lw_in(m) = 0.8_wp * sigma_sb * & 2740 2459 ( pt(k,j,i) * exn1 )**4 2741 2460 ENDIF … … 2743 2462 ! 2744 2463 !-- Weighted average according to surface fraction. 2745 !-- In case no surface fraction is given ( default-type ) 2746 !-- no weighted averaging is performed ( only one surface type per 2747 !-- surface element ). 2748 IF ( ALLOCATED( surf%frac ) ) THEN 2749 2750 surf%rad_lw_out(m) = ( surf%frac(0,m) * surf%emissivity(0,m)& 2751 + surf%frac(1,m) * surf%emissivity(1,m)& 2752 + surf%frac(2,m) * surf%emissivity(2,m)& 2753 ) & 2754 * sigma_sb & 2755 * ( surf%pt_surface(m) * exn )**4 2756 2757 surf%rad_sw_in(m) = ( surf%rad_net(m) - surf%rad_lw_in(m) & 2758 + surf%rad_lw_out(m) ) & 2759 / ( 1.0_wp - & 2760 ( surf%frac(0,m) * surf%albedo(0,m) +& 2761 surf%frac(1,m) * surf%albedo(1,m) +& 2762 surf%frac(1,m) * surf%albedo(1,m) )& 2763 ) 2764 2765 surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m) & 2766 + surf%frac(1,m) * surf%albedo(1,m) & 2767 + surf%frac(2,m) * surf%albedo(2,m) ) & 2768 * surf%rad_sw_in(m) 2769 2770 ELSE 2771 surf%rad_lw_out(m) = surf%emissivity(0,m) & 2772 * sigma_sb & 2773 * ( surf%pt_surface(m) * exn )**4 2774 2775 surf%rad_sw_in(m) = ( surf%rad_net(m) - surf%rad_lw_in(m) & 2776 + surf%rad_lw_out(m) ) & 2777 / ( 1.0_wp - & 2778 ( surf%frac(0,m) * surf%albedo(0,m) )& 2779 ) 2780 2781 surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m) ) & 2782 * surf%rad_sw_in(m) 2783 ENDIF 2464 surf%rad_lw_out(m) = ( surf%frac(0,m) * surf%emissivity(0,m)& 2465 + surf%frac(1,m) * surf%emissivity(1,m)& 2466 + surf%frac(2,m) * surf%emissivity(2,m)& 2467 ) & 2468 * sigma_sb & 2469 * ( surf%pt_surface(m) * exn )**4 2470 2471 surf%rad_sw_in(m) = ( surf%rad_net(m) - surf%rad_lw_in(m) & 2472 + surf%rad_lw_out(m) ) & 2473 / ( 1.0_wp - & 2474 ( surf%frac(0,m) * surf%albedo(0,m) +& 2475 surf%frac(1,m) * surf%albedo(1,m) +& 2476 surf%frac(1,m) * surf%albedo(1,m) )& 2477 ) 2478 2479 surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m) & 2480 + surf%frac(1,m) * surf%albedo(1,m) & 2481 + surf%frac(2,m) * surf%albedo(2,m) ) & 2482 * surf%rad_sw_in(m) 2784 2483 2785 2484 ENDDO … … 2970 2669 ! 2971 2670 !-- Horizontally aligned default, natural and urban surfaces 2972 CALL calc_albedo( surf_def_h(0) )2973 2671 CALL calc_albedo( surf_lsm_h ) 2974 2672 CALL calc_albedo( surf_usm_h ) … … 2976 2674 !-- Vertically aligned default, natural and urban surfaces 2977 2675 DO l = 0, 3 2978 CALL calc_albedo( surf_def_v(l) )2979 2676 CALL calc_albedo( surf_lsm_v(l) ) 2980 2677 CALL calc_albedo( surf_usm_v(l) ) … … 3132 2829 !-- onto respective surface elements 3133 2830 !-- Horizontal surfaces 3134 IF ( surf_def_h(0)%ns > 0 ) THEN3135 surf_def_h(0)%rad_lw_in = rrtm_lwdflx(0,nzb)3136 surf_def_h(0)%rad_lw_out = rrtm_lwuflx(0,nzb)3137 surf_def_h(0)%rad_lw_out_change_0 = rrtm_lwuflx_dt(0,nzb)3138 ENDIF3139 2831 IF ( surf_lsm_h%ns > 0 ) THEN 3140 2832 surf_lsm_h%rad_lw_in = rrtm_lwdflx(0,nzb) … … 3150 2842 !-- Vertical surfaces. 3151 2843 DO l = 0, 3 3152 IF ( surf_def_v(l)%ns > 0 ) THEN3153 surf_def_v(l)%rad_lw_in = rrtm_lwdflx(0,nzb)3154 surf_def_v(l)%rad_lw_out = rrtm_lwuflx(0,nzb)3155 surf_def_v(l)%rad_lw_out_change_0 = rrtm_lwuflx_dt(0,nzb)3156 ENDIF3157 2844 IF ( surf_lsm_v(l)%ns > 0 ) THEN 3158 2845 surf_lsm_v(l)%rad_lw_in = rrtm_lwdflx(0,nzb) … … 3200 2887 !-- Save surface radiative fluxes onto respective surface elements 3201 2888 !-- Horizontal surfaces 3202 IF ( surf_def_h(0)%ns > 0 ) THEN3203 surf_def_h(0)%rad_lw_in = rrtm_swdflx(0,nzb)3204 surf_def_h(0)%rad_lw_out = rrtm_swuflx(0,nzb)3205 ENDIF3206 2889 IF ( surf_lsm_h%ns > 0 ) THEN 3207 2890 surf_lsm_h%rad_sw_in = rrtm_swdflx(0,nzb) … … 3216 2899 !-- level of the surface element 3217 2900 DO l = 0, 3 3218 IF ( surf_def_v(l)%ns > 0 ) THEN3219 surf_def_v(l)%rad_sw_in = rrtm_swdflx(0,nzb)3220 surf_def_v(l)%rad_sw_out = rrtm_swuflx(0,nzb)3221 ENDIF3222 2901 IF ( surf_lsm_v(l)%ns > 0 ) THEN 3223 2902 surf_lsm_v(l)%rad_sw_in = rrtm_swdflx(0,nzb) … … 3369 3048 !-- To obtain bulk parameters, apply a weighted average for these 3370 3049 !-- surfaces. 3371 DO m = surf_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i)3372 rrtm_emis = surf_def_h(0)%emissivity(0,m)3373 rrtm_tsfc = pt(surf_def_h(0)%k(m)+surf_def_h(0)%koff,j,i) * &3374 (surface_pressure / 1000.0_wp )**0.286_wp3375 ENDDO3376 3050 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 3377 3051 rrtm_emis = surf_lsm_h%frac(0,m) * surf_lsm_h%emissivity(0,m) +& … … 3468 3142 !-- onto respective surface elements 3469 3143 !-- Horizontal surfaces 3470 DO m = surf_def_h(0)%start_index(j,i), &3471 surf_def_h(0)%end_index(j,i)3472 surf_def_h(0)%rad_lw_in(m) = rrtm_lwdflx(0,k_topo)3473 surf_def_h(0)%rad_lw_out(m) = rrtm_lwuflx(0,k_topo)3474 surf_def_h(0)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo)3475 ENDDO3476 3144 DO m = surf_lsm_h%start_index(j,i), & 3477 3145 surf_lsm_h%end_index(j,i) … … 3490 3158 !-- respective surface element 3491 3159 DO l = 0, 3 3492 DO m = surf_def_v(l)%start_index(j,i), &3493 surf_def_v(l)%end_index(j,i)3494 k = surf_def_v(l)%k(m)3495 surf_def_v(l)%rad_lw_in(m) = rrtm_lwdflx(0,k)3496 surf_def_v(l)%rad_lw_out(m) = rrtm_lwuflx(0,k)3497 surf_def_v(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k)3498 ENDDO3499 3160 DO m = surf_lsm_v(l)%start_index(j,i), & 3500 3161 surf_lsm_v(l)%end_index(j,i) … … 3523 3184 !-- (Please note, only one loop will entered, controlled by 3524 3185 !-- start-end index.) 3525 DO m = surf_def_h(0)%start_index(j,i), &3526 surf_def_h(0)%end_index(j,i)3527 rrtm_asdir(1) = surf_def_h(0)%rrtm_asdir(0,m)3528 rrtm_asdif(1) = surf_def_h(0)%rrtm_asdif(0,m)3529 rrtm_aldir(1) = surf_def_h(0)%rrtm_aldir(0,m)3530 rrtm_aldif(1) = surf_def_h(0)%rrtm_aldif(0,m)3531 ENDDO3532 3186 DO m = surf_lsm_h%start_index(j,i), & 3533 3187 surf_lsm_h%end_index(j,i) … … 3649 3303 !-- Save surface radiative fluxes onto respective surface elements 3650 3304 !-- Horizontal surfaces 3651 DO m = surf_def_h(0)%start_index(j,i), &3652 surf_def_h(0)%end_index(j,i)3653 surf_def_h(0)%rad_sw_in(m) = rrtm_swdflx(0,k_topo)3654 surf_def_h(0)%rad_sw_out(m) = rrtm_swuflx(0,k_topo)3655 ENDDO3656 3305 DO m = surf_lsm_h%start_index(j,i), & 3657 3306 surf_lsm_h%end_index(j,i) … … 3668 3317 !-- level of the surface element 3669 3318 DO l = 0, 3 3670 DO m = surf_def_v(l)%start_index(j,i), &3671 surf_def_v(l)%end_index(j,i)3672 k = surf_def_v(l)%k(m)3673 surf_def_v(l)%rad_sw_in(m) = rrtm_swdflx(0,k)3674 surf_def_v(l)%rad_sw_out(m) = rrtm_swuflx(0,k)3675 ENDDO3676 3319 DO m = surf_lsm_v(l)%start_index(j,i), & 3677 3320 surf_lsm_v(l)%end_index(j,i) … … 3696 3339 ! 3697 3340 !-- Finally, calculate surface net radiation for surface elements. 3698 !-- First, for horizontal surfaces 3699 DO m = 1, surf_def_h(0)%ns 3700 surf_def_h(0)%rad_net(m) = surf_def_h(0)%rad_sw_in(m) & 3701 - surf_def_h(0)%rad_sw_out(m) & 3702 + surf_def_h(0)%rad_lw_in(m) & 3703 - surf_def_h(0)%rad_lw_out(m) 3704 ENDDO 3341 !-- First, for horizontal surfaces 3705 3342 DO m = 1, surf_lsm_h%ns 3706 3343 surf_lsm_h%rad_net(m) = surf_lsm_h%rad_sw_in(m) & … … 3718 3355 !-- Vertical surfaces. 3719 3356 !-- Todo: weight with azimuth and zenith angle according to their orientation! 3720 DO l = 0, 3 3721 DO m = 1, surf_def_v(l)%ns 3722 surf_def_v(l)%rad_net(m) = surf_def_v(l)%rad_sw_in(m) & 3723 - surf_def_v(l)%rad_sw_out(m) & 3724 + surf_def_v(l)%rad_lw_in(m) & 3725 - surf_def_v(l)%rad_lw_out(m) 3726 ENDDO 3357 DO l = 0, 3 3727 3358 DO m = 1, surf_lsm_v(l)%ns 3728 3359 surf_lsm_v(l)%rad_net(m) = surf_lsm_v(l)%rad_sw_in(m) & … … 7535 7166 DO i = nxl, nxr 7536 7167 DO j = nys, nyn 7537 DO m = surf_def_h(0)%start_index(j,i), &7538 surf_def_h(0)%end_index(j,i)7539 rad_net_av(j,i) = rad_net_av(j,i) + surf_def_h(0)%rad_net(m)7540 ENDDO7541 7168 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 7542 7169 rad_net_av(j,i) = rad_net_av(j,i) + surf_lsm_h%rad_net(m) … … 7824 7451 ! 7825 7452 !-- Obtain rad_net from its respective surface type 7826 !-- Default-type surfaces7827 DO m = surf_def_h(0)%start_index(j,i), &7828 surf_def_h(0)%end_index(j,i)7829 local_pf(i,j,nzb+1) = surf_def_h(0)%rad_net(m)7830 ENDDO7831 !7832 7453 !-- Natural-type surfaces 7833 7454 DO m = surf_lsm_h%start_index(j,i), &
Note: See TracChangeset
for help on using the changeset viewer.
