Changeset 3881 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Apr 10, 2019 9:31:22 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r3861 r3881 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Output of albedo and emissivity moved from USM, bugfixes in initialization 31 ! of albedo 32 ! 33 ! 3861 2019-04-04 06:27:41Z maronga 30 34 ! Bugfix: factor of 4.0 required instead of 3.0 in calculation of rad_lw_out_change_0 31 35 ! … … 1397 1401 unit = 'W/m2' 1398 1402 ELSE IF ( var(1:7) == 'rtm_svf' .OR. var(1:7) == 'rtm_dif' .OR. & 1399 var(1:9) == 'rtm_skyvf' .OR. var(1:9) == 'rtm_skyvft' ) THEN 1403 var(1:9) == 'rtm_skyvf' .OR. var(1:9) == 'rtm_skyvft' .OR. & 1404 var(1:12) == 'rtm_surfalb_' .OR. var(1:13) == 'rtm_surfemis_' ) THEN 1400 1405 IF ( .NOT. radiation ) THEN 1401 1406 message_string = 'output of "' // TRIM( var ) // '" require'& … … 2443 2448 DO ind_type = 0, 2 2444 2449 IF ( surf_lsm_h%albedo_type(ind_type,m) == 0 ) THEN 2445 IF ( albedo_pars_f%pars_xy( 1,j,i) /= albedo_pars_f%fill )&2450 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )& 2446 2451 surf_lsm_h%albedo(ind_type,m) = & 2447 albedo_pars_f%pars_xy( 1,j,i)2452 albedo_pars_f%pars_xy(0,j,i) 2448 2453 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )& 2449 2454 surf_lsm_h%aldir(ind_type,m) = & 2450 2455 albedo_pars_f%pars_xy(1,j,i) 2456 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )& 2457 surf_lsm_h%aldif(ind_type,m) = & 2458 albedo_pars_f%pars_xy(1,j,i) 2451 2459 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )& 2452 surf_lsm_h%a ldif(ind_type,m) = &2460 surf_lsm_h%asdir(ind_type,m) = & 2453 2461 albedo_pars_f%pars_xy(2,j,i) 2454 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )& 2455 surf_lsm_h%asdir(ind_type,m) = & 2456 albedo_pars_f%pars_xy(3,j,i) 2457 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )& 2462 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )& 2458 2463 surf_lsm_h%asdif(ind_type,m) = & 2459 albedo_pars_f%pars_xy( 4,j,i)2464 albedo_pars_f%pars_xy(2,j,i) 2460 2465 ENDIF 2461 2466 ENDDO … … 2469 2474 j = surf_usm_h%j(m) 2470 2475 ! 2471 !-- Spectralalbedos for wall/green/window surfaces2476 !-- Broadband albedos for wall/green/window surfaces 2472 2477 DO ind_type = 0, 2 2473 2478 IF ( surf_usm_h%albedo_type(ind_type,m) == 0 ) THEN 2474 IF ( albedo_pars_f%pars_xy( 1,j,i) /= albedo_pars_f%fill )&2479 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )& 2475 2480 surf_usm_h%albedo(ind_type,m) = & 2476 albedo_pars_f%pars_xy(1,j,i) 2477 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )& 2478 surf_usm_h%aldir(ind_type,m) = & 2479 albedo_pars_f%pars_xy(1,j,i) 2480 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )& 2481 surf_usm_h%aldif(ind_type,m) = & 2482 albedo_pars_f%pars_xy(2,j,i) 2483 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )& 2484 surf_usm_h%asdir(ind_type,m) = & 2485 albedo_pars_f%pars_xy(3,j,i) 2486 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )& 2487 surf_usm_h%asdif(ind_type,m) = & 2488 albedo_pars_f%pars_xy(4,j,i) 2481 albedo_pars_f%pars_xy(0,j,i) 2489 2482 ENDIF 2490 2483 ENDDO 2484 ! 2485 !-- Spectral albedos especially for building wall surfaces 2486 IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill ) THEN 2487 surf_usm_h%aldir(ind_veg_wall,m) = & 2488 albedo_pars_f%pars_xy(1,j,i) 2489 surf_usm_h%aldif(ind_veg_wall,m) = & 2490 albedo_pars_f%pars_xy(1,j,i) 2491 ENDIF 2492 IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill ) THEN 2493 surf_usm_h%asdir(ind_veg_wall,m) = & 2494 albedo_pars_f%pars_xy(2,j,i) 2495 surf_usm_h%asdif(ind_veg_wall,m) = & 2496 albedo_pars_f%pars_xy(2,j,i) 2497 ENDIF 2498 ! 2499 !-- Spectral albedos especially for building green surfaces 2500 IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill ) THEN 2501 surf_usm_h%aldir(ind_pav_green,m) = & 2502 albedo_pars_f%pars_xy(3,j,i) 2503 surf_usm_h%aldif(ind_pav_green,m) = & 2504 albedo_pars_f%pars_xy(3,j,i) 2505 ENDIF 2506 IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill ) THEN 2507 surf_usm_h%asdir(ind_pav_green,m) = & 2508 albedo_pars_f%pars_xy(4,j,i) 2509 surf_usm_h%asdif(ind_pav_green,m) = & 2510 albedo_pars_f%pars_xy(4,j,i) 2511 ENDIF 2512 ! 2513 !-- Spectral albedos especially for building window surfaces 2514 IF ( albedo_pars_f%pars_xy(5,j,i) /= albedo_pars_f%fill ) THEN 2515 surf_usm_h%aldir(ind_wat_win,m) = & 2516 albedo_pars_f%pars_xy(5,j,i) 2517 surf_usm_h%aldif(ind_wat_win,m) = & 2518 albedo_pars_f%pars_xy(5,j,i) 2519 ENDIF 2520 IF ( albedo_pars_f%pars_xy(6,j,i) /= albedo_pars_f%fill ) THEN 2521 surf_usm_h%asdir(ind_wat_win,m) = & 2522 albedo_pars_f%pars_xy(6,j,i) 2523 surf_usm_h%asdif(ind_wat_win,m) = & 2524 albedo_pars_f%pars_xy(6,j,i) 2525 ENDIF 2491 2526 2492 2527 ENDDO … … 2505 2540 DO ind_type = 0, 2 2506 2541 IF ( surf_lsm_v(l)%albedo_type(ind_type,m) == 0 ) THEN 2507 IF ( albedo_pars_f%pars_xy( 1,j+joff,i+ioff) /= &2542 IF ( albedo_pars_f%pars_xy(0,j+joff,i+ioff) /= & 2508 2543 albedo_pars_f%fill ) & 2509 2544 surf_lsm_v(l)%albedo(ind_type,m) = & 2510 albedo_pars_f%pars_xy( 1,j+joff,i+ioff)2545 albedo_pars_f%pars_xy(0,j+joff,i+ioff) 2511 2546 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2512 2547 albedo_pars_f%fill ) & 2513 2548 surf_lsm_v(l)%aldir(ind_type,m) = & 2514 2549 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2550 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2551 albedo_pars_f%fill ) & 2552 surf_lsm_v(l)%aldif(ind_type,m) = & 2553 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2515 2554 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2516 2555 albedo_pars_f%fill ) & 2517 surf_lsm_v(l)%a ldif(ind_type,m) = &2556 surf_lsm_v(l)%asdir(ind_type,m) = & 2518 2557 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2519 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= & 2520 albedo_pars_f%fill ) & 2521 surf_lsm_v(l)%asdir(ind_type,m) = & 2522 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2523 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= & 2558 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2524 2559 albedo_pars_f%fill ) & 2525 2560 surf_lsm_v(l)%asdif(ind_type,m) = & 2526 albedo_pars_f%pars_xy( 4,j+joff,i+ioff)2561 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2527 2562 ENDIF 2528 2563 ENDDO … … 2539 2574 j = surf_usm_v(l)%j(m) 2540 2575 ! 2541 !-- Spectralalbedos for wall/green/window surfaces2576 !-- Broadband albedos for wall/green/window surfaces 2542 2577 DO ind_type = 0, 2 2543 2578 IF ( surf_usm_v(l)%albedo_type(ind_type,m) == 0 ) THEN 2544 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2545 albedo_pars_f%fill ) & 2546 surf_usm_v(l)%albedo(ind_type,m) = & 2547 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2548 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2549 albedo_pars_f%fill ) & 2550 surf_usm_v(l)%aldir(ind_type,m) = & 2551 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2552 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2553 albedo_pars_f%fill ) & 2554 surf_usm_v(l)%aldif(ind_type,m) = & 2555 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2556 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= & 2557 albedo_pars_f%fill ) & 2558 surf_usm_v(l)%asdir(ind_type,m) = & 2559 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2560 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= & 2561 albedo_pars_f%fill ) & 2562 surf_usm_v(l)%asdif(ind_type,m) = & 2563 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2579 IF ( albedo_pars_f%pars_xy(0,j+joff,i+ioff) /= & 2580 albedo_pars_f%fill ) & 2581 surf_usm_v(l)%albedo(ind_type,m) = & 2582 albedo_pars_f%pars_xy(0,j+joff,i+ioff) 2564 2583 ENDIF 2565 2584 ENDDO 2566 2585 ! 2586 !-- Spectral albedos especially for building wall surfaces 2587 IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /= & 2588 albedo_pars_f%fill ) THEN 2589 surf_usm_v(l)%aldir(ind_veg_wall,m) = & 2590 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2591 surf_usm_v(l)%aldif(ind_veg_wall,m) = & 2592 albedo_pars_f%pars_xy(1,j+joff,i+ioff) 2593 ENDIF 2594 IF ( albedo_pars_f%pars_xy(2,j+joff,i+ioff) /= & 2595 albedo_pars_f%fill ) THEN 2596 surf_usm_v(l)%asdir(ind_veg_wall,m) = & 2597 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2598 surf_usm_v(l)%asdif(ind_veg_wall,m) = & 2599 albedo_pars_f%pars_xy(2,j+joff,i+ioff) 2600 ENDIF 2601 ! 2602 !-- Spectral albedos especially for building green surfaces 2603 IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /= & 2604 albedo_pars_f%fill ) THEN 2605 surf_usm_v(l)%aldir(ind_pav_green,m) = & 2606 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2607 surf_usm_v(l)%aldif(ind_pav_green,m) = & 2608 albedo_pars_f%pars_xy(3,j+joff,i+ioff) 2609 ENDIF 2610 IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /= & 2611 albedo_pars_f%fill ) THEN 2612 surf_usm_v(l)%asdir(ind_pav_green,m) = & 2613 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2614 surf_usm_v(l)%asdif(ind_pav_green,m) = & 2615 albedo_pars_f%pars_xy(4,j+joff,i+ioff) 2616 ENDIF 2617 ! 2618 !-- Spectral albedos especially for building window surfaces 2619 IF ( albedo_pars_f%pars_xy(5,j+joff,i+ioff) /= & 2620 albedo_pars_f%fill ) THEN 2621 surf_usm_v(l)%aldir(ind_wat_win,m) = & 2622 albedo_pars_f%pars_xy(5,j+joff,i+ioff) 2623 surf_usm_v(l)%aldif(ind_wat_win,m) = & 2624 albedo_pars_f%pars_xy(5,j+joff,i+ioff) 2625 ENDIF 2626 IF ( albedo_pars_f%pars_xy(6,j+joff,i+ioff) /= & 2627 albedo_pars_f%fill ) THEN 2628 surf_usm_v(l)%asdir(ind_wat_win,m) = & 2629 albedo_pars_f%pars_xy(6,j+joff,i+ioff) 2630 surf_usm_v(l)%asdif(ind_wat_win,m) = & 2631 albedo_pars_f%pars_xy(6,j+joff,i+ioff) 2632 ENDIF 2567 2633 ENDDO 2568 2634 ENDIF … … 9809 9875 var(1:7) == 'rtm_svf' .OR. var(1:7) == 'rtm_dif' .OR. & 9810 9876 var(1:9) == 'rtm_skyvf' .OR. var(1:10) == 'rtm_skyvft' .OR. & 9877 var(1:12) == 'rtm_surfalb_' .OR. var(1:13) == 'rtm_surfemis_' .OR. & 9811 9878 var == 'rtm_mrt' .OR. var == 'rtm_mrt_sw' .OR. var == 'rtm_mrt_lw' ) THEN 9812 9879 … … 10511 10578 ENDIF 10512 10579 10513 !-- block of RTM output variables10514 !-- variables are intended mainly for debugging and detailed analyse purposes10515 CASE ( 'rtm_skyvf' )10516 !-- sky view factor10517 DO isurf = dirstart(ids), dirend(ids)10518 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN10519 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvf(isurf)10520 ENDIF10521 ENDDO10522 10523 CASE ( 'rtm_skyvft' )10524 !-- sky view factor10525 DO isurf = dirstart(ids), dirend(ids)10526 IF ( surfl(id,isurf) == ids ) THEN10527 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvft(isurf)10528 ENDIF10529 ENDDO10530 10531 CASE ( 'rtm_svf', 'rtm_dif' )10532 !-- shape view factors or iradiance factors to selected surface10533 IF ( TRIM(var)=='rtm_svf' ) THEN10534 k = 110535 ELSE10536 k = 210537 ENDIF10538 DO isvf = 1, nsvfl10539 isurflt = svfsurf(1, isvf)10540 isurfs = svfsurf(2, isvf)10541 10542 IF ( surf(ix,isurfs) == is .AND. surf(iy,isurfs) == js .AND. surf(iz,isurfs) == ks .AND. &10543 (surf(id,isurfs) == idsint_u .OR. surfl(id,isurfs) == idsint_l ) ) THEN10544 !-- correct source surface10545 local_pf(surfl(ix,isurflt),surfl(iy,isurflt),surfl(iz,isurflt)) = svf(k,isvf)10546 ENDIF10547 ENDDO10548 10549 10580 CASE ( 'rtm_rad_net' ) 10550 10581 !-- array of complete radiation balance … … 10785 10816 ENDIF 10786 10817 ENDIF 10787 10788 CASE DEFAULT 10789 found = .FALSE. 10818 ! 10819 !-- block of RTM output variables 10820 !-- variables are intended mainly for debugging and detailed analyse purposes 10821 CASE ( 'rtm_skyvf' ) 10822 ! 10823 !-- sky view factor 10824 DO isurf = dirstart(ids), dirend(ids) 10825 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10826 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvf(isurf) 10827 ENDIF 10828 ENDDO 10829 10830 CASE ( 'rtm_skyvft' ) 10831 ! 10832 !-- sky view factor 10833 DO isurf = dirstart(ids), dirend(ids) 10834 IF ( surfl(id,isurf) == ids ) THEN 10835 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvft(isurf) 10836 ENDIF 10837 ENDDO 10838 10839 CASE ( 'rtm_svf', 'rtm_dif' ) 10840 ! 10841 !-- shape view factors or iradiance factors to selected surface 10842 IF ( TRIM(var)=='rtm_svf' ) THEN 10843 k = 1 10844 ELSE 10845 k = 2 10846 ENDIF 10847 DO isvf = 1, nsvfl 10848 isurflt = svfsurf(1, isvf) 10849 isurfs = svfsurf(2, isvf) 10850 10851 IF ( surf(ix,isurfs) == is .AND. surf(iy,isurfs) == js .AND. surf(iz,isurfs) == ks .AND. & 10852 (surf(id,isurfs) == idsint_u .OR. surfl(id,isurfs) == idsint_l ) ) THEN 10853 ! 10854 !-- correct source surface 10855 local_pf(surfl(ix,isurflt),surfl(iy,isurflt),surfl(iz,isurflt)) = svf(k,isvf) 10856 ENDIF 10857 ENDDO 10858 10859 CASE ( 'rtm_surfalb' ) 10860 ! 10861 !-- surface albedo 10862 DO isurf = dirstart(ids), dirend(ids) 10863 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10864 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = albedo_surf(isurf) 10865 ENDIF 10866 ENDDO 10867 10868 CASE ( 'rtm_surfemis' ) 10869 ! 10870 !-- surface emissivity, weighted average 10871 DO isurf = dirstart(ids), dirend(ids) 10872 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10873 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = emiss_surf(isurf) 10874 ENDIF 10875 ENDDO 10876 10877 CASE DEFAULT 10878 found = .FALSE. 10790 10879 10791 10880 END SELECT
Note: See TracChangeset
for help on using the changeset viewer.
