Changeset 4216 for palm


Ignore:
Timestamp:
Sep 4, 2019 9:09:03 AM (20 months ago)
Author:
suehring
Message:

Bugfixes in 3d data output of plant canopy variables

File:
1 edited

Legend:

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

    r4205 r4216  
    2727! -----------------
    2828! $Id$
     29! Bugfixes in 3d data output
     30!
     31! 4205 2019-08-30 13:25:00Z suehring
    2932! Missing working precision + bugfix in calculation of wind speed
    3033!
     
    7578!
    7679! @todo - precalculate constant terms in pcm_calc_transpiration_rate
     80! @todo - unify variable names (pcm_, pc_, ...)
    7781!------------------------------------------------------------------------------!
    7882 MODULE plant_canopy_model_mod
     
    452456!> Subroutine for averaging 3D data
    453457!------------------------------------------------------------------------------!
    454 SUBROUTINE pcm_3d_data_averaging( mode, variable )
     458 SUBROUTINE pcm_3d_data_averaging( mode, variable )
    455459
    456460
     
    602606    ENDIF
    603607
    604 END SUBROUTINE pcm_3d_data_averaging
     608 END SUBROUTINE pcm_3d_data_averaging
    605609
    606610!------------------------------------------------------------------------------!
     
    623627    IMPLICIT NONE
    624628
    625     CHARACTER (LEN=*) ::  variable !<
    626 
    627     INTEGER(iwp) ::  av     !<
    628     INTEGER(iwp) ::  i      !<
    629     INTEGER(iwp) ::  j      !<
    630     INTEGER(iwp) ::  k      !<
     629    CHARACTER (LEN=*) ::  variable !< treated variable
     630
     631    INTEGER(iwp) ::  av     !< flag indicating instantaneous or averaged data output
     632    INTEGER(iwp) ::  i      !< grid index x-direction
     633    INTEGER(iwp) ::  j      !< grid index y-direction
     634    INTEGER(iwp) ::  k      !< grid index z-direction
     635    INTEGER(iwp) ::  kk     !< grid index z-direction relative to canopy arrays
    631636    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
    632637    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
    633638
    634     LOGICAL      ::  found !<
    635 
    636     REAL(wp)     ::  fill_value
    637     REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
     639    LOGICAL      ::  found  !< flag indicating if variable is found
     640
     641    REAL(wp)     ::  fill_value !< fill value
     642    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !< data output array
    638643
    639644
     
    643648
    644649    SELECT CASE ( TRIM( variable ) )
    645 
     650!
     651!--    Note, to save memory arrays for heating are allocated from 0:pch_index.
     652!--    Thus, output must be relative to these array indices. Further, check
     653!--    whether the output is within the vertical output range,
     654!--    i.e. nzb_do:nzt_do.
    646655       CASE ( 'pcm_heatrate' )
    647656          IF ( av == 0 )  THEN
    648657             DO  i = nxl, nxr
    649658                DO  j = nys, nyn
    650                    IF ( pch_index_ji(j,i) /= 0 )  THEN
    651                       DO  k = nzb_do, nzt_do
    652                          local_pf(i,j,k) = pc_heating_rate(k,j,i)
    653                       ENDDO
    654                    ENDIF
     659                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     660                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     661                      kk = k - topo_top_ind(j,i,0)
     662                      local_pf(i,j,k) = pc_heating_rate(kk,j,i)
     663                   ENDDO
    655664                ENDDO
    656665             ENDDO
     
    658667             DO  i = nxl, nxr
    659668                DO  j = nys, nyn
    660                    DO  k = nzb_do, nzt_do
    661                       local_pf(i,j,k) = pcm_heatrate_av(k,j,i)
     669                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     670                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     671                      kk = k - topo_top_ind(j,i,0)
     672                      local_pf(i,j,k) = pcm_heatrate_av(kk,j,i)
    662673                   ENDDO
    663674                ENDDO
     
    669680             DO  i = nxl, nxr
    670681                DO  j = nys, nyn
    671                    IF ( pch_index_ji(j,i) /= 0 )  THEN
    672                       DO  k = nzb_do, nzt_do
    673                          local_pf(i,j,k) = pc_latent_rate(k,j,i)
    674                       ENDDO
    675                    ENDIF
     682                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     683                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     684                      kk = k - topo_top_ind(j,i,0)
     685                      local_pf(i,j,k) = pc_latent_rate(kk,j,i)
     686                   ENDDO
    676687                ENDDO
    677688             ENDDO
     
    679690             DO  i = nxl, nxr
    680691                DO  j = nys, nyn
    681                    DO  k = nzb_do, nzt_do
    682                       local_pf(i,j,k) = pcm_latentrate_av(k,j,i)
     692                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     693                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     694                      kk = k - topo_top_ind(j,i,0)
     695                      local_pf(i,j,k) = pcm_latentrate_av(kk,j,i)
    683696                   ENDDO
    684697                ENDDO
     
    690703             DO  i = nxl, nxr
    691704                DO  j = nys, nyn
    692                    IF ( pch_index_ji(j,i) /= 0 )  THEN
    693                       DO  k = nzb_do, nzt_do
    694                          local_pf(i,j,k) = pc_transpiration_rate(k,j,i)
    695                       ENDDO
    696                    ENDIF
     705                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     706                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     707                      kk = k - topo_top_ind(j,i,0)
     708                      local_pf(i,j,k) = pc_transpiration_rate(kk,j,i)
     709                   ENDDO
    697710                ENDDO
    698711             ENDDO
     
    700713             DO  i = nxl, nxr
    701714                DO  j = nys, nyn
    702                    DO  k = nzb_do, nzt_do
    703                       local_pf(i,j,k) = pcm_transpirationrate_av(k,j,i)
     715                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     716                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     717                      kk = k - topo_top_ind(j,i,0)
     718                      local_pf(i,j,k) = pcm_transpirationrate_av(kk,j,i)
    704719                   ENDDO
    705720                ENDDO
     
    711726             DO  i = nxl, nxr
    712727                DO  j = nys, nyn
    713                    IF ( pch_index_ji(j,i) /= 0 )  THEN
    714                       DO  k = nzb_do, nzt_do
    715                          IF ( pc_latent_rate(k,j,i) /= 0._wp ) THEN
    716                             local_pf(i,j,k) = pc_heating_rate(k,j,i) / &
    717                                               pc_latent_rate(k,j,i)
    718                          ENDIF
    719                       ENDDO
    720                    ENDIF
     728                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     729                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     730                      kk = k - topo_top_ind(j,i,0)
     731                      IF ( pc_latent_rate(kk,j,i) /= 0.0_wp ) THEN
     732                         local_pf(i,j,k) = pc_heating_rate(kk,j,i) /           &
     733                                           pc_latent_rate(kk,j,i)
     734                      ENDIF
     735                   ENDDO
     736                ENDDO
     737             ENDDO
     738          ELSE
     739             DO  i = nxl, nxr
     740                DO  j = nys, nyn
     741                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     742                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     743                      kk = k - topo_top_ind(j,i,0)
     744                      IF ( pcm_latentrate_av(kk,j,i) /= 0.0_wp ) THEN
     745                         local_pf(i,j,k) = pcm_heatrate_av(kk,j,i) /           &
     746                                           pcm_latentrate_av(kk,j,i)
     747                      ENDIF
     748                   ENDDO
    721749                ENDDO
    722750             ENDDO
     
    727755             DO  i = nxl, nxr
    728756                DO  j = nys, nyn
    729                    IF ( pch_index_ji(j,i) /= 0 )  THEN
    730                       DO  k = nzb_do, nzt_do
    731                          local_pf(i,j,k) = lad_s(k,j,i)
    732                       ENDDO
    733                    ENDIF
     757                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
     758                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
     759                      kk = k - topo_top_ind(j,i,0)
     760                      local_pf(i,j,k) = lad_s(kk,j,i)
     761                   ENDDO
    734762                ENDDO
    735763             ENDDO
Note: See TracChangeset for help on using the changeset viewer.