MODULE plant_canopy_model_mod !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: plant_canopy_model.f90 139 2007-11-29 09:37:41Z raasch $ ! ! 138 2007-11-28 10:03:58Z letzel ! Initial revision ! ! Description: ! ------------ ! Evaluation of the drag due to vegetation !------------------------------------------------------------------------------! 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 ! !-- sgs-tke 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) - & 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 IF ( drag_coefficient /= 0.0 ) THEN ! !-- 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 ! !-- sgs-tke CASE ( 4 ) 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 ENDIF END SUBROUTINE plant_canopy_model_ij END MODULE plant_canopy_model_mod