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-2012 Leibniz University Hannover !--------------------------------------------------------------------------------! ! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: plant_canopy_model.f90 1037 2012-10-22 14:10:22Z fricke $ ! ! 1036 2012-10-22 13:43:42Z raasch ! code put under GPL (PALM 3.9) ! ! 257 2009-03-11 15:17:42Z heinze ! Output of messages replaced by message handling routine. ! Bugfix: remove IF statement in plant_canopy_model_ij ! ! 153 2008-03-19 09:41:30Z steinfeld ! heat sources within the forest canopy are added, which represent the ! rate of heat input into the air from the forest leaves, evaluation of sinks ! and sources for scalar concentration due to canopy elements ! ! 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 USE control_parameters USE indices USE pegrid IMPLICIT NONE INTEGER :: component, i, j, 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 )**2 + & ( ( w(k-1,j,i-1) + & w(k-1,j,i) + & w(k,j,i-1) + & w(k,j,i) ) & / 4.0 )**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 )**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 )**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 )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) + & v(k+1,j,i) + & v(k+1,j+1,i) ) & / 4.0 )**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 )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) ) & / 2.0 )**2 + & ( ( w(k-1,j,i) + & w(k,j,i) ) & / 2.0 )**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 * cdc(k,j,i) * lad_s(k,j,i) * & SQRT( ( ( u(k,j,i) + & u(k,j,i+1) ) & / 2.0 )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) ) & / 2.0 )**2 + & ( ( w(k,j,i) + & w(k+1,j,i) ) & / 2.0 )**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 USE control_parameters USE indices USE pegrid IMPLICIT NONE INTEGER :: component, i, j, 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 )**2 + & ( ( w(k-1,j,i-1) + & w(k-1,j,i) + & w(k,j,i-1) + & w(k,j,i) ) & / 4.0 )**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 )**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 )**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 )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) + & v(k+1,j,i) + & v(k+1,j+1,i) ) & / 4.0 )**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 )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) ) & / 2.0 )**2 + & ( ( w(k-1,j,i) + & w(k,j,i) ) & / 2.0 )**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 * cdc(k,j,i) * lad_s(k,j,i) * & SQRT( ( ( u(k,j,i) + & u(k,j,i+1) ) & / 2.0 )**2 + & ( ( v(k,j,i) + & v(k,j+1,i) ) & / 2.0 )**2 + & ( ( w(k,j,i) + & w(k+1,j,i) ) & / 2.0 )**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