MODULE plant_canopy_model_mod !--------------------------------------------------------------------------------! ! This file is part of PALM. ! ! PALM is free software: you can redistribute it and/or modify it under the terms ! of the GNU General Public License as published by the Free Software Foundation, ! either version 3 of the License, or (at your option) any later version. ! ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 1997-2014 Leibniz Universitaet Hannover !--------------------------------------------------------------------------------! ! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: plant_canopy_model.f90 1341 2014-03-25 19:48:09Z hoffmann $ ! ! 1340 2014-03-25 19:45:13Z kanani ! REAL constants defined as wp-kind ! ! 1320 2014-03-20 08:40:49Z raasch ! ONLY-attribute added to USE-statements, ! kind-parameters added to all INTEGER and REAL declaration statements, ! kinds are defined in new module kinds, ! old module precision_kind is removed, ! revision history before 2012 removed, ! comment fields (!:) to be used for variable explanations added to ! all variable declaration statements ! ! 1036 2012-10-22 13:43:42Z raasch ! code put under GPL (PALM 3.9) ! ! 138 2007-11-28 10:03:58Z letzel ! Initial revision ! ! Description: ! ------------ ! Evaluation of sinks and sources of momentum, heat and scalar concentration ! due to canopy elements !------------------------------------------------------------------------------! PRIVATE PUBLIC plant_canopy_model INTERFACE plant_canopy_model MODULE PROCEDURE plant_canopy_model MODULE PROCEDURE plant_canopy_model_ij END INTERFACE plant_canopy_model CONTAINS !------------------------------------------------------------------------------! ! Call for all grid points !------------------------------------------------------------------------------! SUBROUTINE plant_canopy_model( component ) USE arrays_3d, & ONLY: canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w, & q, sec, sls, tend, u, v, w USE control_parameters, & ONLY: pch_index, message_string USE indices, & ONLY: nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner, & nzb_v_inner, nzb_w_inner USE kinds IMPLICIT NONE INTEGER(iwp) :: component !: INTEGER(iwp) :: i !: INTEGER(iwp) :: j !: INTEGER(iwp) :: k !: ! !-- Compute drag for the three velocity components and the SGS-TKE SELECT CASE ( component ) ! !-- u-component CASE ( 1 ) DO i = nxlu, nxr DO j = nys, nyn DO k = nzb_u_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & cdc(k,j,i) * lad_u(k,j,i) * & SQRT( u(k,j,i)**2 + & ( ( v(k,j,i-1) + & v(k,j,i) + & v(k,j+1,i) + & v(k,j+1,i-1) ) & / 4.0_wp )**2 + & ( ( w(k-1,j,i-1) + & w(k-1,j,i) + & w(k,j,i-1) + & w(k,j,i) ) & / 4.0_wp )**2 ) * & u(k,j,i) ENDDO ENDDO ENDDO ! !-- v-component CASE ( 2 ) DO i = nxl, nxr DO j = nysv, nyn DO k = nzb_v_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & cdc(k,j,i) * lad_v(k,j,i) * & SQRT( ( ( u(k,j-1,i) + & u(k,j-1,i+1) + & u(k,j,i) + & u(k,j,i+1) ) & / 4.0_wp )**2 + & v(k,j,i)**2 + & ( ( w(k-1,j-1,i) + & w(k-1,j,i) + & w(k,j-1,i) + & w(k,j,i) ) & / 4.0_wp )**2 ) * & v(k,j,i) ENDDO ENDDO ENDDO ! !-- w-component CASE ( 3 ) DO i = nxl, nxr DO j = nys, nyn DO k = nzb_w_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & cdc(k,j,i) * lad_w(k,j,i) * & SQRT( ( ( u(k,j,i) + & u(k,j,i+1) + & u(k+1,j,i) + & u(k+1,j,i+1) ) & / 4.0_wp )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) + & v(k+1,j,i) + & v(k+1,j+1,i) ) & / 4.0_wp )**2 + & w(k,j,i)**2 ) * & w(k,j,i) ENDDO ENDDO ENDDO ! !-- potential temperature CASE ( 4 ) DO i = nxl, nxr DO j = nys, nyn DO k = nzb_s_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) + & ( canopy_heat_flux(k,j,i) - & canopy_heat_flux(k-1,j,i) ) / & dzw(k) ENDDO ENDDO ENDDO ! !-- scalar concentration CASE ( 5 ) DO i = nxl, nxr DO j = nys, nyn DO k = nzb_s_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & sec(k,j,i) * lad_s(k,j,i) * & SQRT( ( ( u(k,j,i) + & u(k,j,i+1) ) & / 2.0_wp )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) ) & / 2.0_wp )**2 + & ( ( w(k-1,j,i) + & w(k,j,i) ) & / 2.0_wp )**2 ) * & ( q(k,j,i) - sls(k,j,i) ) ENDDO ENDDO ENDDO ! !-- sgs-tke CASE ( 6 ) DO i = nxl, nxr DO j = nys, nyn DO k = nzb_s_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & 2.0_wp * cdc(k,j,i) * lad_s(k,j,i) * & SQRT( ( ( u(k,j,i) + & u(k,j,i+1) ) & / 2.0_wp )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) ) & / 2.0_wp )**2 + & ( ( w(k,j,i) + & w(k+1,j,i) ) & / 2.0_wp )**2 ) * & e(k,j,i) ENDDO ENDDO ENDDO CASE DEFAULT WRITE( message_string, * ) 'wrong component: ', component CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 ) END SELECT END SUBROUTINE plant_canopy_model !------------------------------------------------------------------------------! ! Call for grid point i,j !------------------------------------------------------------------------------! SUBROUTINE plant_canopy_model_ij( i, j, component ) USE arrays_3d, & ONLY: canopy_heat_flux, cdc, dzw, e, lad_s, lad_u, lad_v, lad_w, & q, sec, sls, tend, u, v, w USE control_parameters, & ONLY: pch_index, message_string USE indices, & ONLY: nxl, nxlu, nxr, nys, nysv, nyn, nzb_s_inner, nzb_u_inner, & nzb_v_inner, nzb_w_inner USE kinds IMPLICIT NONE INTEGER(iwp) :: component !: INTEGER(iwp) :: i !: INTEGER(iwp) :: j !: INTEGER(iwp) :: k !: ! !-- Compute drag for the three velocity components SELECT CASE ( component ) ! !-- u-component CASE ( 1 ) DO k = nzb_u_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & cdc(k,j,i) * lad_u(k,j,i) * & SQRT( u(k,j,i)**2 + & ( ( v(k,j,i-1) + & v(k,j,i) + & v(k,j+1,i) + & v(k,j+1,i-1) ) & / 4.0_wp )**2 + & ( ( w(k-1,j,i-1) + & w(k-1,j,i) + & w(k,j,i-1) + & w(k,j,i) ) & / 4.0_wp )**2 ) * & u(k,j,i) ENDDO ! !-- v-component CASE ( 2 ) DO k = nzb_v_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & cdc(k,j,i) * lad_v(k,j,i) * & SQRT( ( ( u(k,j-1,i) + & u(k,j-1,i+1) + & u(k,j,i) + & u(k,j,i+1) ) & / 4.0_wp )**2 + & v(k,j,i)**2 + & ( ( w(k-1,j-1,i) + & w(k-1,j,i) + & w(k,j-1,i) + & w(k,j,i) ) & / 4.0_wp )**2 ) * & v(k,j,i) ENDDO ! !-- w-component CASE ( 3 ) DO k = nzb_w_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & cdc(k,j,i) * lad_w(k,j,i) * & SQRT( ( ( u(k,j,i) + & u(k,j,i+1) + & u(k+1,j,i) + & u(k+1,j,i+1) ) & / 4.0_wp )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) + & v(k+1,j,i) + & v(k+1,j+1,i) ) & / 4.0_wp )**2 + & w(k,j,i)**2 ) * & w(k,j,i) ENDDO ! !-- potential temperature CASE ( 4 ) DO k = nzb_s_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) + & ( canopy_heat_flux(k,j,i) - & canopy_heat_flux(k-1,j,i) ) / & dzw(k) ENDDO ! !-- scalar concentration CASE ( 5 ) DO k = nzb_s_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & sec(k,j,i) * lad_s(k,j,i) * & SQRT( ( ( u(k,j,i) + & u(k,j,i+1) ) & / 2.0_wp )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) ) & / 2.0_wp )**2 + & ( ( w(k-1,j,i) + & w(k,j,i) ) & / 2.0_wp )**2 ) * & ( q(k,j,i) - sls(k,j,i) ) ENDDO ! !-- sgs-tke CASE ( 6 ) DO k = nzb_s_inner(j,i)+1, pch_index tend(k,j,i) = tend(k,j,i) - & 2.0_wp * cdc(k,j,i) * lad_s(k,j,i) * & SQRT( ( ( u(k,j,i) + & u(k,j,i+1) ) & / 2.0_wp )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) ) & / 2.0_wp )**2 + & ( ( w(k,j,i) + & w(k+1,j,i) ) & / 2.0_wp )**2 ) * & e(k,j,i) ENDDO CASE DEFAULT WRITE( message_string, * ) 'wrong component: ', component CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 ) END SELECT END SUBROUTINE plant_canopy_model_ij END MODULE plant_canopy_model_mod