MODULE plant_canopy_model_mod !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Bugfix: remove IF statement in plant_canopy_model_ij ! ! Former revisions: ! ----------------- ! $Id: plant_canopy_model.f90 198 2008-09-17 08:55:28Z steinfeld $ ! ! 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 IF ( myid == 0 ) PRINT*,'+++ pcm: wrong component: ', & component CALL local_stop 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 IF ( myid == 0 ) PRINT*,'+++ pcm: wrong component: ', & component CALL local_stop END SELECT END SUBROUTINE plant_canopy_model_ij END MODULE plant_canopy_model_mod