- Timestamp:
- Nov 16, 2015 12:56:48 PM (9 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/plant_canopy_model.f90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/plant_canopy_model.f90
r1683 r1721 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! bugfixes: shf is reduced in areas covered with canopy only, 22 ! canopy is set on top of topography 22 23 ! 23 24 ! Former revisions: … … 357 358 358 359 ! 359 !-- The surface heat flux is set to the surface value of the calculated 360 !-- in-canopy heat flux distribution 361 shf(:,:) = canopy_heat_flux(0,:,:) 360 !-- In areas covered with canopy, the surface heat flux is set to 361 !-- the surface value of the above calculated in-canopy heat flux 362 !-- distribution 363 DO i = nxlg,nxrg 364 DO j = nysg, nyng 365 IF ( canopy_heat_flux(0,j,i) /= cthf ) THEN 366 shf(j,i) = canopy_heat_flux(0,j,i) 367 ENDIF 368 ENDDO 369 ENDDO 362 370 363 371 ENDIF … … 407 415 INTEGER(iwp) :: j !< running index 408 416 INTEGER(iwp) :: k !< running index 417 INTEGER(iwp) :: kk !< running index for flat lad arrays 409 418 410 419 REAL(wp) :: ddt_3d !< inverse of the LES timestep (dt_3d) … … 427 436 DO i = nxlu, nxr 428 437 DO j = nys, nyn 429 DO k = nzb_u_inner(j,i)+1, pch_index 430 438 DO k = nzb_u_inner(j,i)+1, nzb_u_inner(j,i)+pch_index 439 440 kk = k - nzb_u_inner(j,i) !- lad arrays are defined flat 431 441 ! 432 442 !-- In order to create sharp boundaries of the plant canopy, … … 437 447 !-- For the same reason, the lad at the rightmost(i+1)canopy 438 448 !-- boundary on the u-grid equals lad_s(k,j,i). 439 lad_local = lad_s(k ,j,i)440 IF ( lad_local == 0.0_wp .AND.&441 lad_s(k,j,i-1) > 0.0_wp )THEN442 lad_local = lad_s(k ,j,i-1)449 lad_local = lad_s(kk,j,i) 450 IF ( lad_local == 0.0_wp .AND. lad_s(kk,j,i-1) > 0.0_wp )& 451 THEN 452 lad_local = lad_s(kk,j,i-1) 443 453 ENDIF 444 454 … … 487 497 DO i = nxl, nxr 488 498 DO j = nysv, nyn 489 DO k = nzb_v_inner(j,i)+1, pch_index 490 499 DO k = nzb_v_inner(j,i)+1, nzb_v_inner(j,i)+pch_index 500 501 kk = k - nzb_v_inner(j,i) !- lad arrays are defined flat 491 502 ! 492 503 !-- In order to create sharp boundaries of the plant canopy, … … 497 508 !-- For the same reason, the lad at the northmost(j+1) canopy 498 509 !-- boundary on the v-grid equals lad_s(k,j,i). 499 lad_local = lad_s(k ,j,i)500 IF ( lad_local == 0.0_wp .AND.&501 lad_s(k,j-1,i) > 0.0_wp )THEN502 lad_local = lad_s(k ,j-1,i)510 lad_local = lad_s(kk,j,i) 511 IF ( lad_local == 0.0_wp .AND. lad_s(kk,j-1,i) > 0.0_wp )& 512 THEN 513 lad_local = lad_s(kk,j-1,i) 503 514 ENDIF 504 515 … … 547 558 DO i = nxl, nxr 548 559 DO j = nys, nyn 549 DO k = nzb_w_inner(j,i)+1, pch_index-1 560 DO k = nzb_w_inner(j,i)+1, nzb_w_inner(j,i)+pch_index-1 561 562 kk = k - nzb_w_inner(j,i) !- lad arrays are defined flat 550 563 551 564 pre_tend = 0.0_wp … … 555 568 pre_tend = - cdc * & 556 569 (0.5_wp * & 557 ( lad_s(k +1,j,i) + lad_s(k,j,i) )) *&570 ( lad_s(kk+1,j,i) + lad_s(kk,j,i) )) * & 558 571 SQRT( ( 0.25_wp * ( u(k,j,i) + & 559 572 u(k,j,i+1) + & … … 593 606 DO i = nxl, nxr 594 607 DO j = nys, nyn 595 DO k = nzb_s_inner(j,i)+1, pch_index 608 DO k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index 609 kk = k - nzb_s_inner(j,i) !- lad arrays are defined flat 596 610 tend(k,j,i) = tend(k,j,i) + & 597 ( canopy_heat_flux(k ,j,i) -&598 canopy_heat_flux(k -1,j,i) ) / dzw(k)611 ( canopy_heat_flux(kk,j,i) - & 612 canopy_heat_flux(kk-1,j,i) ) / dzw(k) 599 613 ENDDO 600 614 ENDDO … … 606 620 DO i = nxl, nxr 607 621 DO j = nys, nyn 608 DO k = nzb_s_inner(j,i)+1, pch_index 622 DO k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index 623 kk = k - nzb_s_inner(j,i) !- lad arrays are defined flat 609 624 tend(k,j,i) = tend(k,j,i) - & 610 625 lsec * & 611 lad_s(k ,j,i) *&626 lad_s(kk,j,i) * & 612 627 SQRT( ( 0.5_wp * ( u(k,j,i) + & 613 628 u(k,j,i+1) ) & … … 630 645 DO i = nxl, nxr 631 646 DO j = nys, nyn 632 DO k = nzb_s_inner(j,i)+1, pch_index 647 DO k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index 648 kk = k - nzb_s_inner(j,i) !- lad arrays are defined flat 633 649 tend(k,j,i) = tend(k,j,i) - & 634 650 2.0_wp * cdc * & 635 lad_s(k ,j,i) *&651 lad_s(kk,j,i) * & 636 652 SQRT( ( 0.5_wp * ( u(k,j,i) + & 637 653 u(k,j,i+1) ) & … … 698 714 INTEGER(iwp) :: j !< running index 699 715 INTEGER(iwp) :: k !< running index 716 INTEGER(iwp) :: kk !< running index for flat lad arrays 700 717 701 718 REAL(wp) :: ddt_3d !< inverse of the LES timestep (dt_3d) … … 716 733 !-- u-component 717 734 CASE ( 1 ) 718 DO k = nzb_u_inner(j,i)+1, pch_index 719 735 DO k = nzb_u_inner(j,i)+1, nzb_u_inner(j,i)+pch_index 736 737 kk = k - nzb_u_inner(j,i) !- lad arrays are defined flat 720 738 ! 721 739 !-- In order to create sharp boundaries of the plant canopy, … … 726 744 !-- For the same reason, the lad at the rightmost(i+1)canopy 727 745 !-- boundary on the u-grid equals lad_s(k,j,i). 728 lad_local = lad_s(k,j,i) 729 IF ( lad_local == 0.0_wp .AND. & 730 lad_s(k,j,i-1) > 0.0_wp ) THEN 731 lad_local = lad_s(k,j,i-1) 746 lad_local = lad_s(kk,j,i) 747 IF ( lad_local == 0.0_wp .AND. lad_s(kk,j,i-1) > 0.0_wp ) THEN 748 lad_local = lad_s(kk,j,i-1) 732 749 ENDIF 733 750 … … 772 789 !-- v-component 773 790 CASE ( 2 ) 774 DO k = nzb_v_inner(j,i)+1, pch_index 775 791 DO k = nzb_v_inner(j,i)+1, nzb_v_inner(j,i)+pch_index 792 793 kk = k - nzb_v_inner(j,i) !- lad arrays are defined flat 776 794 ! 777 795 !-- In order to create sharp boundaries of the plant canopy, … … 782 800 !-- For the same reason, the lad at the northmost(j+1)canopy 783 801 !-- boundary on the v-grid equals lad_s(k,j,i). 784 lad_local = lad_s(k,j,i) 785 IF ( lad_local == 0.0_wp .AND. & 786 lad_s(k,j-1,i) > 0.0_wp ) THEN 787 lad_local = lad_s(k,j-1,i) 802 lad_local = lad_s(kk,j,i) 803 IF ( lad_local == 0.0_wp .AND. lad_s(kk,j-1,i) > 0.0_wp ) THEN 804 lad_local = lad_s(kk,j-1,i) 788 805 ENDIF 789 806 … … 828 845 !-- w-component 829 846 CASE ( 3 ) 830 DO k = nzb_w_inner(j,i)+1, pch_index-1 847 DO k = nzb_w_inner(j,i)+1, nzb_w_inner(j,i)+pch_index-1 848 849 kk = k - nzb_w_inner(j,i) !- lad arrays are defined flat 831 850 832 851 pre_tend = 0.0_wp … … 836 855 pre_tend = - cdc * & 837 856 (0.5_wp * & 838 ( lad_s(k +1,j,i) + lad_s(k,j,i) )) *&857 ( lad_s(kk+1,j,i) + lad_s(kk,j,i) )) * & 839 858 SQRT( ( 0.25_wp * ( u(k,j,i) + & 840 859 u(k,j,i+1) + & … … 869 888 !-- potential temperature 870 889 CASE ( 4 ) 871 DO k = nzb_s_inner(j,i)+1, pch_index 890 DO k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index 891 kk = k - nzb_s_inner(j,i) !- lad arrays are defined flat 872 892 tend(k,j,i) = tend(k,j,i) + & 873 ( canopy_heat_flux(k ,j,i) -&874 canopy_heat_flux(k -1,j,i) ) / dzw(k)893 ( canopy_heat_flux(kk,j,i) - & 894 canopy_heat_flux(kk-1,j,i) ) / dzw(k) 875 895 ENDDO 876 896 … … 879 899 !-- scalar concentration 880 900 CASE ( 5 ) 881 DO k = nzb_s_inner(j,i)+1, pch_index 901 DO k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index 902 kk = k - nzb_s_inner(j,i) !- lad arrays are defined flat 882 903 tend(k,j,i) = tend(k,j,i) - & 883 904 lsec * & 884 lad_s(k ,j,i) *&905 lad_s(kk,j,i) * & 885 906 SQRT( ( 0.5_wp * ( u(k,j,i) + & 886 907 u(k,j,i+1) ) & … … 899 920 !-- sgs-tke 900 921 CASE ( 6 ) 901 DO k = nzb_s_inner(j,i)+1, pch_index 922 DO k = nzb_s_inner(j,i)+1, nzb_s_inner(j,i)+pch_index 923 kk = k - nzb_s_inner(j,i) !- lad arrays are defined flat 902 924 tend(k,j,i) = tend(k,j,i) - & 903 925 2.0_wp * cdc * & 904 lad_s(k ,j,i) *&926 lad_s(kk,j,i) * & 905 927 SQRT( ( 0.5_wp * ( u(k,j,i) + & 906 928 u(k,j,i+1) ) &
Note: See TracChangeset
for help on using the changeset viewer.
