Changeset 4341 for palm


Ignore:
Timestamp:
Dec 16, 2019 10:43:49 AM (4 years ago)
Author:
motisi
Message:

plant_canopy_model: unification of variable names: pc_ variabels now pcm_ variables
removal of bowenratio output
canopy mode 'block' now 'homogeneous'
'read_from_file_3d' now 'read_from_file'
removal of confusing comment lines
replacement of k_wall by topo_top_ind
removal of else-statement in tendency-calculation

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

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

    r4335 r4341  
    2727! -----------------
    2828! $Id$
     29! - Unification of variable names: pc_-variables now pcm_-variables
     30!   (pc_latent_rate, pc_heating_rate, pc_transpiration_rate)
     31! - Removal of pcm_bowenratio output
     32! - Renamed canopy-mode 'block' to 'homogeneous'
     33! - Renamed value 'read_from_file_3d' to 'read_from_file'
     34! - Removal of confusing comment lines
     35! - Replacement of k_wall by topo_top_ind
     36! - Removal of Else-Statement in tendency-calculation
     37!
     38! 4335 2019-12-12 16:39:05Z suehring
    2939! Fix for LAD at building edges also implemented in vector branch.
    3040!
     
    140150
    141151
    142     CHARACTER (LEN=30)   ::  canopy_mode = 'block'                 !< canopy coverage
     152    CHARACTER (LEN=30)   ::  canopy_mode = 'homogeneous'           !< canopy coverage
    143153    LOGICAL              ::  plant_canopy_transpiration = .FALSE.  !< flag to switch calculation of transpiration and corresponding latent heat
    144154                                                                   !< for resolved plant canopy inside radiation model
     
    177187    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  cum_lai_hf               !< cumulative lai for heatflux calc.
    178188    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  lad_s                    !< lad on scalar-grid
    179     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_heating_rate          !< plant canopy heating rate
    180     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_transpiration_rate    !< plant canopy transpiration rate
    181     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_latent_rate           !< plant canopy latent heating rate
     189    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_heating_rate         !< plant canopy heating rate
     190    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_transpiration_rate   !< plant canopy transpiration rate
     191    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_latent_rate          !< plant canopy latent heating rate
    182192
    183193    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_heatrate_av          !< array for averaging plant canopy sensible heating rate
     
    199209!
    200210!-- Public variables and constants
    201     PUBLIC cdc, pc_heating_rate, pc_transpiration_rate, pc_latent_rate,       &
     211    PUBLIC cdc, pcm_heating_rate, pcm_transpiration_rate, pcm_latent_rate,    &
    202212           canopy_mode, cthf, dt_plant_canopy, lad, lad_s, pch_index,         &
    203213           plant_canopy_transpiration
     
    398408          unit = 'K s-1'
    399409
    400        CASE ( 'pcm_bowenratio' )
    401           unit = 'K s-1'
    402 
    403410       CASE ( 'pcm_lad' )
    404411          unit = 'm2 m-3'
     
    472479!
    473480!--    If canopy shall be read from file, static input file must be present
    474        IF ( TRIM( canopy_mode ) == 'read_from_file_3d' .AND.                   &
     481       IF ( TRIM( canopy_mode ) == 'read_from_file' .AND.                   &
    475482            .NOT. input_pids_static )  THEN
    476           message_string = 'canopy_mode = read_from_file_3d requires ' //      &
     483          message_string = 'canopy_mode = read_from_file requires ' //      &
    477484                           'static input file'
    478485          CALL message( 'pcm_check_parameters', 'PA0672', 1, 2, 0, 6, 0 )
     
    547554                      IF ( pch_index_ji(j,i) /= 0 )  THEN
    548555                         DO  k = 0, pch_index_ji(j,i)
    549                             pcm_heatrate_av(k,j,i) = pcm_heatrate_av(k,j,i) + pc_heating_rate(k,j,i)
     556                            pcm_heatrate_av(k,j,i) = pcm_heatrate_av(k,j,i) + pcm_heating_rate(k,j,i)
    550557                         ENDDO
    551558                      ENDIF
     
    561568                      IF ( pch_index_ji(j,i) /= 0 )  THEN
    562569                         DO  k = 0, pch_index_ji(j,i)
    563                             pcm_latentrate_av(k,j,i) = pcm_latentrate_av(k,j,i) + pc_latent_rate(k,j,i)
     570                            pcm_latentrate_av(k,j,i) = pcm_latentrate_av(k,j,i) + pcm_latent_rate(k,j,i)
    564571                         ENDDO
    565572                      ENDIF
     
    575582                      IF ( pch_index_ji(j,i) /= 0 )  THEN
    576583                         DO  k = 0, pch_index_ji(j,i)
    577                             pcm_transpirationrate_av(k,j,i) = pcm_transpirationrate_av(k,j,i) + pc_transpiration_rate(k,j,i)
     584                            pcm_transpirationrate_av(k,j,i) = pcm_transpirationrate_av(k,j,i) + pcm_transpiration_rate(k,j,i)
    578585                         ENDDO
    579586                      ENDIF
     
    693700                DO  j = nys, nyn
    694701                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
    695                       local_pf(i,j,k) = pc_heating_rate(k,j,i)
     702                      local_pf(i,j,k) = pcm_heating_rate(k,j,i)
    696703                   ENDDO
    697704                ENDDO
     
    712719                DO  j = nys, nyn
    713720                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
    714                       local_pf(i,j,k) = pc_latent_rate(k,j,i)
     721                      local_pf(i,j,k) = pcm_latent_rate(k,j,i)
    715722                   ENDDO
    716723                ENDDO
     
    731738                DO  j = nys, nyn
    732739                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
    733                       local_pf(i,j,k) = pc_transpiration_rate(k,j,i)
     740                      local_pf(i,j,k) = pcm_transpiration_rate(k,j,i)
    734741                   ENDDO
    735742                ENDDO
     
    745752          ENDIF
    746753
    747        CASE ( 'pcm_bowenratio' )
    748           IF ( av == 0 )  THEN
    749              DO  i = nxl, nxr
    750                 DO  j = nys, nyn
    751                    DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
    752                       IF ( pc_latent_rate(k,j,i) /= 0.0_wp ) THEN
    753                          local_pf(i,j,k) = pc_heating_rate(k,j,i) /            &
    754                                            pc_latent_rate(k,j,i)
    755                       ENDIF
    756                    ENDDO
    757                 ENDDO
    758              ENDDO
    759           ELSE
    760              DO  i = nxl, nxr
    761                 DO  j = nys, nyn
    762                    DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
    763                       IF ( pcm_latentrate_av(k,j,i) /= 0.0_wp ) THEN
    764                          local_pf(i,j,k) = pcm_heatrate_av(k,j,i) /            &
    765                                            pcm_latentrate_av(k,j,i)
    766                       ENDIF
    767                    ENDDO
    768                 ENDDO
    769              ENDDO
    770           ENDIF
    771 
    772754       CASE ( 'pcm_lad' )
    773755          IF ( av == 0 )  THEN
     
    812794     SELECT CASE ( TRIM( var ) )
    813795
    814         CASE ( 'pcm_heatrate', 'pcm_lad', 'pcm_transpirationrate', 'pcm_latentrate', 'pcm_bowenratio')
     796        CASE ( 'pcm_heatrate', 'pcm_lad', 'pcm_transpirationrate', 'pcm_latentrate')
    815797           grid_x = 'x'
    816798           grid_y = 'y'
     
    10871069!
    10881070!--    Initialization of the canopy coverage in the model domain:
    1089 !--    Setting the parameter canopy_mode = 'block' initializes a canopy, which
     1071!--    Setting the parameter canopy_mode = 'homogeneous' initializes a canopy, which
    10901072!--    fully covers the domain surface
    10911073       SELECT CASE ( TRIM( canopy_mode ) )
    10921074
    1093           CASE( 'block' )
     1075          CASE( 'homogeneous' )
    10941076
    10951077             DO  i = nxlg, nxrg
     
    10991081             ENDDO
    11001082
    1101           CASE ( 'read_from_file_3d' )
     1083          CASE ( 'read_from_file' )
    11021084!
    11031085!--          Initialize LAD with data from file. If LAD is given in NetCDF file,
     
    12191201#endif
    12201202
    1221 !--    Allocation of arrays pc_heating_rate, pc_transpiration_rate and pc_latent_rate
    1222        ALLOCATE( pc_heating_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
    1223        pc_heating_rate = 0.0_wp
     1203!--    Allocation of arrays pcm_heating_rate, pcm_transpiration_rate and pcm_latent_rate
     1204       ALLOCATE( pcm_heating_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
     1205       pcm_heating_rate = 0.0_wp
    12241206       
    12251207       IF ( humidity )  THEN
    1226           ALLOCATE( pc_transpiration_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
    1227           pc_transpiration_rate = 0.0_wp
    1228           ALLOCATE( pc_latent_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
    1229           pc_latent_rate = 0.0_wp
     1208          ALLOCATE( pcm_transpiration_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
     1209          pcm_transpiration_rate = 0.0_wp
     1210          ALLOCATE( pcm_latent_rate(0:pch_index,nysg:nyng,nxlg:nxrg) )
     1211          pcm_latent_rate = 0.0_wp
    12301212       ENDIF
    12311213!
     
    12411223!--    73–96). This approach has been applied e.g. by Shaw & Schumann (1992;
    12421224!--    Bound.-Layer Meteorol. 61, 47–64).
    1243 !--    When using the radiation_interactions, canopy heating (pc_heating_rate)
    1244 !--    and plant canopy transpiration (pc_transpiration_rate, pc_latent_rate)
     1225!--    When using the radiation_interactions, canopy heating (pcm_heating_rate)
     1226!--    and plant canopy transpiration (pcm_transpiration_rate, pcm_latent_rate)
    12451227!--    are calculated in the RTM after the calculation of radiation.
    1246 !--    We cannot use variable radiation_interactions here to determine the situation
    1247 !--    as it is assigned in init_3d_model after the call of pcm_init.
    12481228       IF ( cthf /= 0.0_wp )  THEN
    12491229
     
    13141294!--       canopy.
    13151295!--       Within the different canopy layers the plant-canopy heating
    1316 !--       rate (pc_heating_rate) is calculated as the vertical
     1296!--       rate (pcm_heating_rate) is calculated as the vertical
    13171297!--       divergence of the canopy heat fluxes at the top and bottom
    13181298!--       of the respective layer
     
    13211301                DO  k = 1, pch_index_ji(j,i)
    13221302                   IF ( cum_lai_hf(0,j,i) /= 0.0_wp )  THEN
    1323                       pc_heating_rate(k,j,i) = cthf *                          &
     1303                      pcm_heating_rate(k,j,i) = cthf *                          &
    13241304                                ( exp(-ext_coef*cum_lai_hf(k,j,i)) -           &
    13251305                                  exp(-ext_coef*cum_lai_hf(k-1,j,i) ) ) / dzw(k)
     
    15661546       INTEGER(iwp) ::  j         !< running index
    15671547       INTEGER(iwp) ::  k         !< running index
    1568        INTEGER(iwp) ::  k_wall    !< vertical index of topography top
    15691548       INTEGER(iwp) ::  kk        !< running index for flat lad arrays
    15701549
     
    16041583!
    16051584!--                Determine topography-top index on u-grid
    1606                    k_wall = topo_top_ind(j,i,1)
    1607                    DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
    1608 
    1609                       kk = k - k_wall   !- lad arrays are defined flat
     1585                   DO  k = topo_top_ind(j,i,1)+1, topo_top_ind(j,i,1) + pch_index_ji(j,i)
     1586
     1587                      kk = k - topo_top_ind(j,i,1)   !- lad arrays are defined flat
    16101588!
    16111589!--                   In order to create sharp boundaries of the plant canopy,
     
    16601638                      IF ( SIGN(pre_u,u(k,j,i)) /= pre_u )  THEN
    16611639                         pre_tend = - u(k,j,i) * ddt_3d
    1662                       ELSE
    1663                          pre_tend = pre_tend
    16641640                      ENDIF
    16651641!
     
    16871663!
    16881664!--                Determine topography-top index on v-grid
    1689                    k_wall = topo_top_ind(j,i,2)
    1690 
    1691                    DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
    1692 
    1693                       kk = k - k_wall   !- lad arrays are defined flat
     1665                   DO  k = topo_top_ind(j,i,2)+1, topo_top_ind(j,i,2) + pch_index_ji(j,i)
     1666
     1667                      kk = k - topo_top_ind(j,i,2)   !- lad arrays are defined flat
    16941668!
    16951669!--                   In order to create sharp boundaries of the plant canopy,
     
    17621736!
    17631737!--                Determine topography-top index on w-grid
    1764                    k_wall = topo_top_ind(j,i,3)
    1765 
    1766                    DO  k = k_wall+1, k_wall + pch_index_ji(j,i) - 1
    1767 
    1768                       kk = k - k_wall   !- lad arrays are defined flat
     1738                   DO  k = topo_top_ind(j,i,3)+1, topo_top_ind(j,i,3) + pch_index_ji(j,i) - 1
     1739
     1740                      kk = k - topo_top_ind(j,i,3)   !- lad arrays are defined flat
    17691741
    17701742                      pre_tend = 0.0_wp
     
    18141786                   DO  j = nys, nyn
    18151787!--                   Determine topography-top index on scalar-grid
    1816                       k_wall = topo_top_ind(j,i,0)
    1817                       DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
    1818                          kk = k - k_wall   !- lad arrays are defined flat
    1819                          tend(k,j,i) = tend(k,j,i) + pc_heating_rate(kk,j,i) - pc_latent_rate(kk,j,i)
     1788                      DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     1789                         kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
     1790                         tend(k,j,i) = tend(k,j,i) + pcm_heating_rate(kk,j,i) - pcm_latent_rate(kk,j,i)
    18201791                      ENDDO
    18211792                   ENDDO
     
    18251796                   DO  j = nys, nyn
    18261797!--                   Determine topography-top index on scalar-grid
    1827                       k_wall = topo_top_ind(j,i,0)
    1828                       DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
    1829                          kk = k - k_wall   !- lad arrays are defined flat
    1830                          tend(k,j,i) = tend(k,j,i) + pc_heating_rate(kk,j,i)
     1798                      DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     1799                         kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
     1800                         tend(k,j,i) = tend(k,j,i) + pcm_heating_rate(kk,j,i)
    18311801                      ENDDO
    18321802                   ENDDO
     
    18411811!
    18421812!--                Determine topography-top index on scalar-grid
    1843                    k_wall = topo_top_ind(j,i,0)
    1844 
    1845                    DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
    1846 
    1847                       kk = k - k_wall   !- lad arrays are defined flat
     1813                   DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     1814
     1815                      kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
    18481816
    18491817                      IF ( .NOT. plant_canopy_transpiration ) THEN
    1850                          ! pc_transpiration_rate is calculated in radiation model
     1818                         ! pcm_transpiration_rate is calculated in radiation model
    18511819                         ! in case of plant_canopy_transpiration = .T.
    18521820                         ! to include also the dependecy to the radiation
    18531821                         ! in the plant canopy box
    1854                          pc_transpiration_rate(kk,j,i) =  - lsec               &
     1822                         pcm_transpiration_rate(kk,j,i) =  - lsec               &
    18551823                                          * lad_s(kk,j,i) *                    &
    18561824                                          SQRT( ( 0.5_wp * ( u(k,j,i) +        &
     
    18671835                      ENDIF
    18681836
    1869                       tend(k,j,i) = tend(k,j,i) + pc_transpiration_rate(kk,j,i)
     1837                      tend(k,j,i) = tend(k,j,i) + pcm_transpiration_rate(kk,j,i)
    18701838                   ENDDO
    18711839                ENDDO
     
    18791847!
    18801848!--                Determine topography-top index on scalar-grid
    1881                    k_wall = topo_top_ind(j,i,0)
    1882 
    1883                    DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
    1884 
    1885                       kk = k - k_wall   !- lad arrays are defined flat
     1849                   DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     1850
     1851                      kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
    18861852                      tend(k,j,i) = tend(k,j,i) -                              &
    18871853                                       2.0_wp * cdc *                          &
     
    19081874!
    19091875!--                Determine topography-top index on scalar-grid
    1910                    k_wall = topo_top_ind(j,i,0)
    1911 
    1912                    DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
    1913 
    1914                       kk = k - k_wall   !- lad arrays are defined flat
     1876                   DO  k = topo_top_ind(j,i,0)+1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     1877
     1878                      kk = k - topo_top_ind(j,i,0)   !- lad arrays are defined flat
    19151879                      tend(k,j,i) = tend(k,j,i) -                              &
    19161880                                       lsec *                                  &
     
    19811945       INTEGER(iwp) ::  j         !< running index
    19821946       INTEGER(iwp) ::  k         !< running index
    1983        INTEGER(iwp) ::  k_wall    !< vertical index of topography top
    19841947       INTEGER(iwp) ::  kk        !< running index for flat lad arrays
    19851948
     
    20161979!
    20171980!--          Determine topography-top index on u-grid
    2018              k_wall = topo_top_ind(j,i,1)
    2019              DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
    2020 
    2021                 kk = k - k_wall  !- lad arrays are defined flat
     1981             DO  k = topo_top_ind(j,i,1) + 1, topo_top_ind(j,i,1) + pch_index_ji(j,i)
     1982
     1983                kk = k - topo_top_ind(j,i,1)  !- lad arrays are defined flat
    20221984
    20231985!
     
    20962058!
    20972059!--          Determine topography-top index on v-grid
    2098              k_wall = topo_top_ind(j,i,2)
    2099              DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
    2100 
    2101                 kk = k - k_wall  !- lad arrays are defined flat
     2060             DO  k = topo_top_ind(j,i,2) + 1, topo_top_ind(j,i,2) + pch_index_ji(j,i)
     2061
     2062                kk = k - topo_top_ind(j,i,2)  !- lad arrays are defined flat
    21022063!
    21032064!--             In order to create sharp boundaries of the plant canopy,
     
    21662127!
    21672128!--          Determine topography-top index on w-grid
    2168              k_wall = topo_top_ind(j,i,3)
    2169 
    2170              DO  k = k_wall + 1, k_wall + pch_index_ji(j,i) - 1
    2171 
    2172                 kk = k - k_wall  !- lad arrays are defined flat
     2129             DO  k = topo_top_ind(j,i,3) + 1, topo_top_ind(j,i,3) + pch_index_ji(j,i) - 1
     2130
     2131                kk = k - topo_top_ind(j,i,3)  !- lad arrays are defined flat
    21732132
    21742133                pre_tend = 0.0_wp
     
    22132172!
    22142173!--          Determine topography-top index on scalar grid
    2215              k_wall = topo_top_ind(j,i,0)
    2216 
    22172174             IF ( humidity ) THEN
    2218                 DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
    2219                    kk = k - k_wall  !- lad arrays are defined flat
    2220                    tend(k,j,i) = tend(k,j,i) + pc_heating_rate(kk,j,i) -       &
    2221                                  pc_latent_rate(kk,j,i)
     2175                DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     2176                   kk = k - topo_top_ind(j,i,0)  !- lad arrays are defined flat
     2177                   tend(k,j,i) = tend(k,j,i) + pcm_heating_rate(kk,j,i) -       &
     2178                                 pcm_latent_rate(kk,j,i)
    22222179                ENDDO
    22232180             ELSE
    2224                 DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
    2225                    kk = k - k_wall  !- lad arrays are defined flat
    2226                    tend(k,j,i) = tend(k,j,i) + pc_heating_rate(kk,j,i)
     2181                DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     2182                   kk = k - topo_top_ind(j,i,0)  !- lad arrays are defined flat
     2183                   tend(k,j,i) = tend(k,j,i) + pcm_heating_rate(kk,j,i)
    22272184                ENDDO
    22282185             ENDIF
     
    22332190!
    22342191!--          Determine topography-top index on scalar grid
    2235              k_wall = topo_top_ind(j,i,0)
    2236 
    2237              DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
    2238                 kk = k - k_wall  !- lad arrays are defined flat
     2192             DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     2193                kk = k - topo_top_ind(j,i,0)  !- lad arrays are defined flat
    22392194                IF ( .NOT. plant_canopy_transpiration ) THEN
    2240                    ! pc_transpiration_rate is calculated in radiation model
     2195                   ! pcm_transpiration_rate is calculated in radiation model
    22412196                   ! in case of plant_canopy_transpiration = .T.
    22422197                   ! to include also the dependecy to the radiation
    22432198                   ! in the plant canopy box
    2244                    pc_transpiration_rate(kk,j,i) = - lsec                      &
     2199                   pcm_transpiration_rate(kk,j,i) = - lsec                      &
    22452200                                    * lad_s(kk,j,i) *                          &
    22462201                                    SQRT( ( 0.5_wp * ( u(k,j,i) +              &
     
    22572212                ENDIF
    22582213
    2259                 tend(k,j,i) = tend(k,j,i) + pc_transpiration_rate(kk,j,i)
     2214                tend(k,j,i) = tend(k,j,i) + pcm_transpiration_rate(kk,j,i)
    22602215
    22612216             ENDDO   
     
    22662221!
    22672222!--          Determine topography-top index on scalar grid
    2268              k_wall = topo_top_ind(j,i,0)
    2269 
    2270              DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
    2271 
    2272                 kk = k - k_wall
     2223             DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     2224
     2225                kk = k - topo_top_ind(j,i,0)
    22732226                tend(k,j,i) = tend(k,j,i) -                                    &
    22742227                                 2.0_wp * cdc *                                &
     
    22922245!
    22932246!--          Determine topography-top index on scalar grid
    2294              k_wall = topo_top_ind(j,i,0)
    2295 
    2296              DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
    2297 
    2298                 kk = k - k_wall
     2247             DO  k = topo_top_ind(j,i,0) + 1, topo_top_ind(j,i,0) + pch_index_ji(j,i)
     2248
     2249                kk = k - topo_top_ind(j,i,0)
    22992250                tend(k,j,i) = tend(k,j,i) -                                    &
    23002251                                 lsec *                                        &
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r4340 r4341  
    2828! -----------------
    2929! $Id$
     30! Renamed pc_heating_rate, pc_transpiration_rate, pc_transpiration_rate to
     31! pcm_heating_rate, pcm_latent_rate, pcm_transpiration_rate
     32!
     33! 4340 2019-12-16 08:17:03Z Giersch
    3034! Albedo indices for building_surface_pars are now declared as parameters to
    3135! prevent an error if the gfortran compiler with -Werror=unused-value is used
     
    302306
    303307    USE plant_canopy_model_mod,                                                &
    304         ONLY:  lad_s, pc_heating_rate, pc_transpiration_rate, pc_latent_rate,  &
    305                plant_canopy_transpiration, pcm_calc_transpiration_rate
     308        ONLY:  lad_s,                                                          &
     309               pcm_heating_rate,                                               &
     310               pcm_transpiration_rate,                                         &
     311               pcm_latent_rate,                                                &
     312               plant_canopy_transpiration,                                     &
     313               pcm_calc_transpiration_rate
    306314
    307315    USE pegrid
     
    61506158!--  push heat flux absorbed by plant canopy to respective 3D arrays
    61516159     IF ( npcbl > 0 )  THEN
    6152          pc_heating_rate(:,:,:) = 0.0_wp
     6160         pcm_heating_rate(:,:,:) = 0.0_wp
    61536161         DO ipcgb = 1, npcbl
    61546162             j = pcbl(iy, ipcgb)
     
    61586166!--          Following expression equals former kk = k - nzb_s_inner(j,i)
    61596167             kk = k - topo_top_ind(j,i,0)  !- lad arrays are defined flat
    6160              pc_heating_rate(kk, j, i) = (pcbinsw(ipcgb) + pcbinlw(ipcgb)) &
     6168             pcm_heating_rate(kk, j, i) = (pcbinsw(ipcgb) + pcbinlw(ipcgb)) &
    61616169                 * pchf_prep(k) * pt(k, j, i) !-- = dT/dt
    61626170         ENDDO
     
    61646172         IF ( humidity .AND. plant_canopy_transpiration ) THEN
    61656173!--          Calculation of plant canopy transpiration rate and correspondidng latent heat rate
    6166              pc_transpiration_rate(:,:,:) = 0.0_wp
    6167              pc_latent_rate(:,:,:) = 0.0_wp
     6174             pcm_transpiration_rate(:,:,:) = 0.0_wp
     6175             pcm_latent_rate(:,:,:) = 0.0_wp
    61686176             DO ipcgb = 1, npcbl
    61696177                 i = pcbl(ix, ipcgb)
     
    61726180                 kk = k - topo_top_ind(j,i,0)  !- lad arrays are defined flat
    61736181                 CALL pcm_calc_transpiration_rate( i, j, k, kk, pcbinsw(ipcgb), pcbinlw(ipcgb), &
    6174                                                    pc_transpiration_rate(kk,j,i), pc_latent_rate(kk,j,i) )
     6182                                                   pcm_transpiration_rate(kk,j,i), pcm_latent_rate(kk,j,i) )
    61756183              ENDDO
    61766184         ENDIF
  • palm/trunk/SOURCE/user_init_plant_canopy.f90

    r4182 r4341  
    2525! -----------------
    2626! $Id$
     27! Renamed canopy_mode 'block' to 'homogeneous'
     28!
     29! 4182 2019-08-22 15:20:23Z scharf
    2730! Corrected "Former revisions" section
    2831!
     
    6972    SELECT CASE ( TRIM( canopy_mode ) )
    7073
    71        CASE ( 'block' )
     74       CASE ( 'homogeneous' )
    7275!
    7376!--       Not allowed here since this is the standard case used in init_3d_model.
Note: See TracChangeset for help on using the changeset viewer.