Changeset 1721 for palm/trunk/SOURCE


Ignore:
Timestamp:
Nov 16, 2015 12:56:48 PM (9 years ago)
Author:
raasch
Message:

bugfixes: shf is reduced in areas covered with canopy only, canopy is set on top of topography

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/plant_canopy_model.f90

    r1683 r1721  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! bugfixes: shf is reduced in areas covered with canopy only,
     22!           canopy is set on top of topography
    2223!
    2324! Former revisions:
     
    357358
    358359!
    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
    362370
    363371       ENDIF
     
    407415       INTEGER(iwp) ::  j         !< running index
    408416       INTEGER(iwp) ::  k         !< running index
     417       INTEGER(iwp) ::  kk        !< running index for flat lad arrays
    409418
    410419       REAL(wp) ::  ddt_3d    !< inverse of the LES timestep (dt_3d)
     
    427436             DO  i = nxlu, nxr
    428437                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
    431441!
    432442!--                   In order to create sharp boundaries of the plant canopy,
     
    437447!--                   For the same reason, the lad at the rightmost(i+1)canopy
    438448!--                   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 )  THEN
    442                          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)
    443453                      ENDIF
    444454
     
    487497             DO  i = nxl, nxr
    488498                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
    491502!
    492503!--                   In order to create sharp boundaries of the plant canopy,
     
    497508!--                   For the same reason, the lad at the northmost(j+1) canopy
    498509!--                   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 )  THEN
    502                          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)
    503514                      ENDIF
    504515
     
    547558             DO  i = nxl, nxr
    548559                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
    550563
    551564                      pre_tend = 0.0_wp
     
    555568                      pre_tend = - cdc *                                       &
    556569                                   (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) )) *   &
    558571                                   SQRT( ( 0.25_wp * ( u(k,j,i)   +            &
    559572                                                       u(k,j,i+1) +            &
     
    593606             DO  i = nxl, nxr
    594607                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
    596610                      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)
    599613                   ENDDO
    600614                ENDDO
     
    606620             DO  i = nxl, nxr
    607621                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
    609624                      tend(k,j,i) = tend(k,j,i) -                              &
    610625                                       lsec *                                  &
    611                                        lad_s(k,j,i) *                          &
     626                                       lad_s(kk,j,i) *                         &
    612627                                       SQRT( ( 0.5_wp * ( u(k,j,i) +           &
    613628                                                          u(k,j,i+1) )         &
     
    630645             DO  i = nxl, nxr
    631646                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
    633649                      tend(k,j,i) = tend(k,j,i) -                              &
    634650                                       2.0_wp * cdc *                          &
    635                                        lad_s(k,j,i) *                          &
     651                                       lad_s(kk,j,i) *                         &
    636652                                       SQRT( ( 0.5_wp * ( u(k,j,i) +           &
    637653                                                          u(k,j,i+1) )         &
     
    698714       INTEGER(iwp) ::  j         !< running index
    699715       INTEGER(iwp) ::  k         !< running index
     716       INTEGER(iwp) ::  kk        !< running index for flat lad arrays
    700717
    701718       REAL(wp) ::  ddt_3d    !< inverse of the LES timestep (dt_3d)
     
    716733!--       u-component
    717734          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
    720738!
    721739!--             In order to create sharp boundaries of the plant canopy,
     
    726744!--             For the same reason, the lad at the rightmost(i+1)canopy
    727745!--             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)
    732749                ENDIF
    733750
     
    772789!--       v-component
    773790          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
    776794!
    777795!--             In order to create sharp boundaries of the plant canopy,
     
    782800!--             For the same reason, the lad at the northmost(j+1)canopy
    783801!--             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)
    788805                ENDIF
    789806
     
    828845!--       w-component
    829846          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
    831850
    832851                pre_tend = 0.0_wp
     
    836855                pre_tend = - cdc *                                             &
    837856                             (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) )) *         &
    839858                             SQRT( ( 0.25_wp * ( u(k,j,i)    +                 & 
    840859                                                 u(k,j,i+1)  +                 &
     
    869888!--       potential temperature
    870889          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
    872892                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)
    875895             ENDDO
    876896
     
    879899!--       scalar concentration
    880900          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
    882903                tend(k,j,i) = tend(k,j,i) -                                    &
    883904                                 lsec *                                        &
    884                                  lad_s(k,j,i) *                                &
     905                                 lad_s(kk,j,i) *                               &
    885906                                 SQRT( ( 0.5_wp * ( u(k,j,i) +                 &
    886907                                                    u(k,j,i+1) )               &
     
    899920!--       sgs-tke
    900921          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
    902924                tend(k,j,i) = tend(k,j,i) -                                    &
    903925                                 2.0_wp * cdc *                                &
    904                                  lad_s(k,j,i) *                                &
     926                                 lad_s(kk,j,i) *                               &
    905927                                 SQRT( ( 0.5_wp * ( u(k,j,i) +                 &
    906928                                                    u(k,j,i+1) )               &
Note: See TracChangeset for help on using the changeset viewer.