Ignore:
Timestamp:
Jul 30, 2019 2:47:10 PM (2 years ago)
Author:
suehring
Message:

Merge with branch resler: biomet- output of bio_mrt added; plant_canopy - separate vertical dimension for 3D output (to save disk space); radiation - remove unused plant canopy variables; urban-surface model - do not add anthropogenic heat during wall spin-up

File:
1 edited

Legend:

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

    r3885 r4127  
    2727! -----------------
    2828! $Id$
     29! Output of 3D plant canopy variables changed. It is now relative to the local
     30! terrain rather than located at the acutal vertical level in the model. This
     31! way, the vertical dimension of the output can be significantly reduced.
     32! (merge from branch resler)
     33!
     34! 3885 2019-04-11 11:29:34Z kanani
    2935! Changes related to global restructuring of location messages and introduction
    3036! of additional debug messages
     
    311317    REAL(wp), DIMENSION(:), ALLOCATABLE ::  pre_lad        !< preliminary lad
    312318   
    313     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  cum_lai_hf             !< cumulative lai for heatflux calc.
    314     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  lad_s                  !< lad on scalar-grid
    315     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_heating_rate        !< plant canopy heating rate
    316     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_transpiration_rate  !< plant canopy transpiration rate
    317     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_latent_rate         !< plant canopy latent heating rate
     319    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  cum_lai_hf               !< cumulative lai for heatflux calc.
     320    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  lad_s                    !< lad on scalar-grid
     321    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_heating_rate          !< plant canopy heating rate
     322    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_transpiration_rate    !< plant canopy transpiration rate
     323    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_latent_rate           !< plant canopy latent heating rate
     324
     325    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_heatrate_av          !< array for averaging plant canopy sensible heating rate
     326    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_latentrate_av        !< array for averaging plant canopy latent heating rate
     327    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pcm_transpirationrate_av !< array for averaging plant canopy transpiration rate
    318328
    319329    SAVE
     
    325335!-- Public functions
    326336    PUBLIC pcm_calc_transpiration_rate, pcm_check_data_output,                &
    327            pcm_check_parameters, pcm_data_output_3d, pcm_define_netcdf_grid,  &
     337           pcm_check_parameters, pcm_3d_data_averaging,                       &
     338           pcm_data_output_3d, pcm_define_netcdf_grid,                        &
    328339           pcm_header, pcm_init, pcm_parin, pcm_tendency
    329340
     
    345356       MODULE PROCEDURE pcm_check_parameters
    346357    END INTERFACE pcm_check_parameters
     358
     359    INTERFACE pcm_3d_data_averaging
     360       MODULE PROCEDURE pcm_3d_data_averaging
     361    END INTERFACE pcm_3d_data_averaging
    347362
    348363    INTERFACE pcm_data_output_3d
     
    618633! Description:
    619634! ------------
    620 !> Subroutine defining 3D output variables
     635!> Subroutine for averaging 3D data
     636!------------------------------------------------------------------------------!
     637SUBROUTINE pcm_3d_data_averaging( mode, variable )
     638
     639
     640    USE control_parameters
     641
     642    USE indices
     643
     644    USE kinds
     645
     646    IMPLICIT NONE
     647
     648    CHARACTER (LEN=*) ::  mode    !<
     649    CHARACTER (LEN=*) :: variable !<
     650
     651    INTEGER(iwp) ::  i            !<
     652    INTEGER(iwp) ::  j            !<
     653    INTEGER(iwp) ::  k            !<
     654
     655
     656    IF ( mode == 'allocate' )  THEN
     657
     658       SELECT CASE ( TRIM( variable ) )
     659
     660          CASE ( 'pcm_heatrate' )
     661             IF ( .NOT. ALLOCATED( pcm_heatrate_av ) )  THEN
     662                ALLOCATE( pcm_heatrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
     663             ENDIF
     664             pcm_heatrate_av = 0.0_wp
     665
     666
     667          CASE ( 'pcm_latentrate' )
     668             IF ( .NOT. ALLOCATED( pcm_latentrate_av ) )  THEN
     669                ALLOCATE( pcm_latentrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
     670             ENDIF
     671             pcm_latentrate_av = 0.0_wp
     672
     673
     674          CASE ( 'pcm_transpirationrate' )
     675             IF ( .NOT. ALLOCATED( pcm_transpirationrate_av ) )  THEN
     676                ALLOCATE( pcm_transpirationrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) )
     677             ENDIF
     678             pcm_transpirationrate_av = 0.0_wp
     679
     680          CASE DEFAULT
     681             CONTINUE
     682
     683       END SELECT
     684
     685    ELSEIF ( mode == 'sum' )  THEN
     686
     687       SELECT CASE ( TRIM( variable ) )
     688
     689          CASE ( 'pcm_heatrate' )
     690             IF ( ALLOCATED( pcm_heatrate_av ) ) THEN
     691                DO  i = nxl, nxr
     692                   DO  j = nys, nyn
     693                      IF ( pch_index_ji(j,i) /= 0 )  THEN
     694                         DO  k = 0, pch_index_ji(j,i)
     695                            pcm_heatrate_av(k,j,i) = pcm_heatrate_av(k,j,i) + pc_heating_rate(k,j,i)
     696                         ENDDO
     697                      ENDIF
     698                   ENDDO
     699                ENDDO
     700             ENDIF
     701
     702
     703          CASE ( 'pcm_latentrate' )
     704             IF ( ALLOCATED( pcm_latentrate_av ) ) THEN
     705                DO  i = nxl, nxr
     706                   DO  j = nys, nyn
     707                      IF ( pch_index_ji(j,i) /= 0 )  THEN
     708                         DO  k = 0, pch_index_ji(j,i)
     709                            pcm_latentrate_av(k,j,i) = pcm_latentrate_av(k,j,i) + pc_latent_rate(k,j,i)
     710                         ENDDO
     711                      ENDIF
     712                   ENDDO
     713                ENDDO
     714             ENDIF
     715
     716
     717          CASE ( 'pcm_transpirationrate' )
     718             IF ( ALLOCATED( pcm_transpirationrate_av ) ) THEN
     719                DO  i = nxl, nxr
     720                   DO  j = nys, nyn
     721                      IF ( pch_index_ji(j,i) /= 0 )  THEN
     722                         DO  k = 0, pch_index_ji(j,i)
     723                            pcm_transpirationrate_av(k,j,i) = pcm_transpirationrate_av(k,j,i) + pc_transpiration_rate(k,j,i)
     724                         ENDDO
     725                      ENDIF
     726                   ENDDO
     727                ENDDO
     728             ENDIF
     729
     730          CASE DEFAULT
     731             CONTINUE
     732
     733       END SELECT
     734
     735    ELSEIF ( mode == 'average' )  THEN
     736
     737       SELECT CASE ( TRIM( variable ) )
     738
     739          CASE ( 'pcm_heatrate' )
     740             IF ( ALLOCATED( pcm_heatrate_av ) ) THEN
     741                DO  i = nxlg, nxrg
     742                   DO  j = nysg, nyng
     743                      IF ( pch_index_ji(j,i) /= 0 )  THEN
     744                         DO  k = 0, pch_index_ji(j,i)
     745                            pcm_heatrate_av(k,j,i) = pcm_heatrate_av(k,j,i)                 &
     746                                                     / REAL( average_count_3d, KIND=wp )
     747                         ENDDO
     748                      ENDIF
     749                   ENDDO
     750                ENDDO
     751             ENDIF
     752
     753
     754          CASE ( 'pcm_latentrate' )
     755             IF ( ALLOCATED( pcm_latentrate_av ) ) THEN
     756                DO  i = nxlg, nxrg
     757                   DO  j = nysg, nyng
     758                      IF ( pch_index_ji(j,i) /= 0 )  THEN
     759                         DO  k = 0, pch_index_ji(j,i)
     760                            pcm_latentrate_av(k,j,i) = pcm_latentrate_av(k,j,i)              &
     761                                                       / REAL( average_count_3d, KIND=wp )
     762                         ENDDO
     763                      ENDIF
     764                   ENDDO
     765                ENDDO
     766             ENDIF
     767
     768
     769          CASE ( 'pcm_transpirationrate' )
     770             IF ( ALLOCATED( pcm_transpirationrate_av ) ) THEN
     771                DO  i = nxlg, nxrg
     772                   DO  j = nysg, nyng
     773                      IF ( pch_index_ji(j,i) /= 0 )  THEN
     774                         DO  k = 0, pch_index_ji(j,i)
     775                            pcm_transpirationrate_av(k,j,i) = pcm_transpirationrate_av(k,j,i)  &
     776                                                              / REAL( average_count_3d, KIND=wp )
     777                         ENDDO
     778                      ENDIF
     779                   ENDDO
     780                ENDDO
     781             ENDIF
     782
     783       END SELECT
     784
     785    ENDIF
     786
     787END SUBROUTINE pcm_3d_data_averaging
     788
     789!------------------------------------------------------------------------------!
     790!
     791! Description:
     792! ------------
     793!> Subroutine defining 3D output variables.
     794!> Note, 3D plant-canopy output has it's own vertical output dimension, meaning
     795!> that 3D output is relative to the model surface now rather than at the actual
     796!> grid point where the plant canopy is located.
    621797!------------------------------------------------------------------------------!
    622798 SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value,     &
     
    636812    INTEGER(iwp) ::  j      !<
    637813    INTEGER(iwp) ::  k      !<
    638     INTEGER(iwp) ::  k_topo !< topography top index
    639814    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
    640815    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
     
    652827    SELECT CASE ( TRIM( variable ) )
    653828
    654       CASE ( 'pcm_heatrate' )
    655          IF ( av == 0 )  THEN
    656             DO  i = nxl, nxr
    657                DO  j = nys, nyn
    658                   IF ( pch_index_ji(j,i) /= 0 )  THEN
    659                      k_topo = get_topography_top_index_ji( j, i, 's' )
    660                      DO  k = k_topo, k_topo + pch_index_ji(j,i)
    661                         local_pf(i,j,k) = pc_heating_rate(k-k_topo,j,i)
    662                      ENDDO
    663                   ENDIF
    664                ENDDO
    665             ENDDO
    666          ENDIF
    667    
     829       CASE ( 'pcm_heatrate' )
     830          IF ( av == 0 )  THEN
     831             DO  i = nxl, nxr
     832                DO  j = nys, nyn
     833                   IF ( pch_index_ji(j,i) /= 0 )  THEN
     834                      DO  k = nzb_do, nzt_do
     835                         local_pf(i,j,k) = pc_heating_rate(k,j,i)
     836                      ENDDO
     837                   ENDIF
     838                ENDDO
     839             ENDDO
     840          ELSE
     841             DO  i = nxl, nxr
     842                DO  j = nys, nyn
     843                   DO  k = nzb_do, nzt_do
     844                      local_pf(i,j,k) = pcm_heatrate_av(k,j,i)
     845                   ENDDO
     846                ENDDO
     847             ENDDO
     848          ENDIF
     849
     850       CASE ( 'pcm_latentrate' )
     851          IF ( av == 0 )  THEN
     852             DO  i = nxl, nxr
     853                DO  j = nys, nyn
     854                   IF ( pch_index_ji(j,i) /= 0 )  THEN
     855                      DO  k = nzb_do, nzt_do
     856                         local_pf(i,j,k) = pc_latent_rate(k,j,i)
     857                      ENDDO
     858                   ENDIF
     859                ENDDO
     860             ENDDO
     861          ELSE
     862             DO  i = nxl, nxr
     863                DO  j = nys, nyn
     864                   DO  k = nzb_do, nzt_do
     865                      local_pf(i,j,k) = pcm_latentrate_av(k,j,i)
     866                   ENDDO
     867                ENDDO
     868             ENDDO
     869          ENDIF
     870
    668871       CASE ( 'pcm_transpirationrate' )
    669          IF ( av == 0 )  THEN
    670             DO  i = nxl, nxr
    671                DO  j = nys, nyn
    672                   IF ( pch_index_ji(j,i) /= 0 )  THEN
    673                      k_topo = get_topography_top_index_ji( j, i, 's' )
    674                      DO  k = k_topo, k_topo + pch_index_ji(j,i)
    675                         local_pf(i,j,k) = pc_transpiration_rate(k-k_topo,j,i)
    676                      ENDDO
    677                   ENDIF
    678                ENDDO
    679             ENDDO
    680          ENDIF
    681 
    682        CASE ( 'pcm_latentrate' )
    683          IF ( av == 0 )  THEN
    684             DO  i = nxl, nxr
    685                DO  j = nys, nyn
    686                   IF ( pch_index_ji(j,i) /= 0 )  THEN
    687                      k_topo = get_topography_top_index_ji( j, i, 's' )
    688                      DO  k = k_topo, k_topo + pch_index_ji(j,i)
    689                         local_pf(i,j,k) = pc_latent_rate(k-k_topo,j,i)
    690                      ENDDO
    691                   ENDIF
    692                ENDDO
    693             ENDDO
    694          ENDIF
     872          IF ( av == 0 )  THEN
     873             DO  i = nxl, nxr
     874                DO  j = nys, nyn
     875                   IF ( pch_index_ji(j,i) /= 0 )  THEN
     876                      DO  k = nzb_do, nzt_do
     877                         local_pf(i,j,k) = pc_transpiration_rate(k,j,i)
     878                      ENDDO
     879                   ENDIF
     880                ENDDO
     881             ENDDO
     882          ELSE
     883             DO  i = nxl, nxr
     884                DO  j = nys, nyn
     885                   DO  k = nzb_do, nzt_do
     886                      local_pf(i,j,k) = pcm_transpirationrate_av(k,j,i)
     887                   ENDDO
     888                ENDDO
     889             ENDDO
     890          ENDIF
    695891
    696892       CASE ( 'pcm_bowenratio' )
    697          IF ( av == 0 )  THEN
    698             DO  i = nxl, nxr
    699                DO  j = nys, nyn
    700                   IF ( pch_index_ji(j,i) /= 0 )  THEN
    701                      k_topo = get_topography_top_index_ji( j, i, 's' )
    702                      DO  k = k_topo, k_topo + pch_index_ji(j,i)
    703                         IF ( pc_latent_rate(k-k_topo,j,i) /= 0._wp ) THEN
    704                            local_pf(i,j,k) = pc_heating_rate(k-k_topo,j,i) / &
    705                                              pc_latent_rate(k-k_topo,j,i)
    706                         ENDIF
    707                      ENDDO
    708                   ENDIF
    709                ENDDO
    710             ENDDO
    711          ENDIF
    712 
    713       CASE ( 'pcm_lad' )
    714          IF ( av == 0 )  THEN
    715             DO  i = nxl, nxr
    716                DO  j = nys, nyn
    717                   IF ( pch_index_ji(j,i) /= 0 )  THEN
    718                      k_topo = get_topography_top_index_ji( j, i, 's' )
    719                      DO  k = k_topo, k_topo + pch_index_ji(j,i)
    720                         local_pf(i,j,k) = lad_s(k-k_topo,j,i)
    721                      ENDDO
    722                   ENDIF
    723                ENDDO
    724             ENDDO
    725          ENDIF
    726                  
    727          
     893          IF ( av == 0 )  THEN
     894             DO  i = nxl, nxr
     895                DO  j = nys, nyn
     896                   IF ( pch_index_ji(j,i) /= 0 )  THEN
     897                      DO  k = nzb_do, nzt_do
     898                         IF ( pc_latent_rate(k,j,i) /= 0._wp ) THEN
     899                            local_pf(i,j,k) = pc_heating_rate(k,j,i) / &
     900                                              pc_latent_rate(k,j,i)
     901                         ENDIF
     902                      ENDDO
     903                   ENDIF
     904                ENDDO
     905             ENDDO
     906          ENDIF
     907
     908       CASE ( 'pcm_lad' )
     909          IF ( av == 0 )  THEN
     910             DO  i = nxl, nxr
     911                DO  j = nys, nyn
     912                   IF ( pch_index_ji(j,i) /= 0 )  THEN
     913                      DO  k = nzb_do, nzt_do
     914                         local_pf(i,j,k) = lad_s(k,j,i)
     915                      ENDDO
     916                   ENDIF
     917                ENDDO
     918             ENDDO
     919          ENDIF
     920
    728921       CASE DEFAULT
    729922          found = .FALSE.
     
    760953           grid_x = 'x'
    761954           grid_y = 'y'
    762            grid_z = 'zu'
     955           grid_z = 'zpc'
    763956
    764957        CASE DEFAULT
Note: See TracChangeset for help on using the changeset viewer.