Ignore:
Timestamp:
May 9, 2018 8:42:38 AM (4 years ago)
Author:
maronga
Message:

series of bugfixes

File:
1 edited

Legend:

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

    r2977 r3014  
    2525! -----------------
    2626! $Id$
     27! Bugfix: nzb_do and nzt_do were not used for 3d data output
     28! Added pc_transpiration_rate
     29!
     30! 2977 2018-04-17 10:27:57Z kanani
    2731! Implement changes from branch radiation (r2948-2971) with minor modifications,
    2832! plus some formatting.
     
    230234    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  lad_s            !< lad on scalar-grid
    231235    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_heating_rate  !< plant canopy heating rate
     236    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_transpiration_rate  !< plant canopy transpiration rate
    232237
    233238    SAVE
     
    243248!
    244249!-- Public variables and constants
    245     PUBLIC pc_heating_rate, canopy_mode, cthf, dt_plant_canopy, lad, lad_s,   &
     250    PUBLIC pc_heating_rate, pc_transpiration_rate, canopy_mode, cthf, dt_plant_canopy, lad, lad_s,   &
    246251           pch_index
    247252           
     
    315320          unit = 'K s-1'
    316321   
     322       CASE ( 'pcm_transpirationrate' )
     323          unit = 'kg kg-1 s-1'
     324
    317325       CASE ( 'pcm_lad' )
    318326          unit = 'm2 m-3'
     
    404412!> Subroutine defining 3D output variables
    405413!------------------------------------------------------------------------------!
    406  SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value )
    407  
    408     USE control_parameters,                                                    &
    409         ONLY :  nz_do3d
    410  
     414 SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value,     &
     415                                nzb_do, nzt_do )
     416 
    411417    USE indices
    412418
     
    423429    INTEGER(iwp) ::  k      !<
    424430    INTEGER(iwp) ::  k_topo !< topography top index
     431    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
     432    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
    425433
    426434    LOGICAL      ::  found !<
    427435
    428436    REAL(wp)     ::  fill_value
    429     REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nz_do3d) ::  local_pf !<
     437    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
    430438
    431439
     
    449457            ENDDO
    450458         ENDIF
    451    
     459   
     460       CASE ( 'pcm_transpirationrate' )
     461         IF ( av == 0 )  THEN
     462            DO  i = nxl, nxr
     463               DO  j = nys, nyn
     464                  IF ( pch_index_ji(j,i) /= 0 )  THEN
     465                     k_topo = get_topography_top_index_ji( j, i, 's' )
     466                     DO  k = k_topo, k_topo + pch_index_ji(j,i)
     467                        local_pf(i,j,k) = pc_transpiration_rate(k-k_topo,j,i)
     468                     ENDDO
     469                  ENDIF
     470               ENDDO
     471            ENDDO
     472         ENDIF
    452473   
    453474      CASE ( 'pcm_lad' )
     
    497518     SELECT CASE ( TRIM( var ) )
    498519
    499         CASE ( 'pcm_heatrate', 'pcm_lad' )
     520        CASE ( 'pcm_heatrate', 'pcm_lad', 'pcm_transpirationrate')
    500521           grid_x = 'x'
    501522           grid_y = 'y'
     
    873894
    874895          ALLOCATE( cum_lai_hf(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                 &
    875                     pc_heating_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     896                    pc_heating_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg),            &
     897                    pc_transpiration_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    876898!
    877899!--       Piecewise calculation of the cumulative leaf area index by vertical
     
    13971419
    13981420                      kk = k - k_wall   !- lad arrays are defined flat
    1399                       tend(k,j,i) = tend(k,j,i) -                              &
    1400                                        lsec *                                  &
    1401                                        lad_s(kk,j,i) *                         &
     1421                      pc_transpiration_rate(kk,j,i) =  - lsec                  &
     1422                                       * lad_s(kk,j,i) *                       &
    14021423                                       SQRT( ( 0.5_wp * ( u(k,j,i) +           &
    14031424                                                          u(k,j,i+1) )         &
     
    14111432                                           ) *                                 &
    14121433                                       ( q(k,j,i) - lsc )
     1434
     1435                      tend(k,j,i) = tend(k,j,i) + pc_transpiration_rate(kk,j,i)
    14131436                   ENDDO
    14141437                ENDDO
     
    17281751
    17291752             DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
    1730 
    1731                 kk = k - k_wall
    1732                 tend(k,j,i) = tend(k,j,i) -                                    &
    1733                                  lsec *                                        &
    1734                                  lad_s(kk,j,i) *                               &
     1753                kk = k - k_wall  !- lad arrays are defined flat
     1754
     1755                pc_transpiration_rate(kk,j,i) = - lsec                         &
     1756                                 * lad_s(kk,j,i) *                             &
    17351757                                 SQRT( ( 0.5_wp * ( u(k,j,i) +                 &
    17361758                                                    u(k,j,i+1) )               &
     
    17441766                                     ) *                                       &
    17451767                                 ( q(k,j,i) - lsc )
     1768
     1769                tend(k,j,i) = tend(k,j,i) + pc_transpiration_rate(kk,j,i)
     1770
    17461771             ENDDO   
    17471772
Note: See TracChangeset for help on using the changeset viewer.