MODULE diffusion_s_mod !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: diffusion_s.f90 4 2007-02-13 11:33:16Z raasch $ ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.8 2006/02/23 10:34:17 raasch ! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner ! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface ! fluxes at vertically oriented topography ! ! Revision 1.1 2000/04/13 14:54:02 schroeter ! Initial revision ! ! ! Description: ! ------------ ! Diffusion term of scalar quantities (temperature and water content) !------------------------------------------------------------------------------! PRIVATE PUBLIC diffusion_s INTERFACE diffusion_s MODULE PROCEDURE diffusion_s MODULE PROCEDURE diffusion_s_ij END INTERFACE diffusion_s CONTAINS !------------------------------------------------------------------------------! ! Call for all grid points !------------------------------------------------------------------------------! SUBROUTINE diffusion_s( ddzu, ddzw, kh, s, s_flux, tend ) USE control_parameters USE grid_variables USE indices IMPLICIT NONE INTEGER :: i, j, k REAL :: vertical_gridspace REAL :: ddzu(1:nzt+1), ddzw(1:nzt) REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) REAL, DIMENSION(:,:), POINTER :: s_flux REAL, DIMENSION(:,:,:), POINTER :: kh, s DO i = nxl, nxr DO j = nys,nyn ! !-- Compute horizontal diffusion DO k = nzb_s_outer(j,i)+1, nzt-1 tend(k,j,i) = tend(k,j,i) & + 0.5 * ( & ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) & - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) & ) * ddx2 & + 0.5 * ( & ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) & - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) & ) * ddy2 ENDDO ! !-- Apply prescribed horizontal wall heatflux where necessary IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) & THEN DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i) tend(k,j,i) = tend(k,j,i) & + 0.5 * ( fwxp(j,i) * & ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) & - ( 1.0 - fwxp(j,i) ) * wall_heatflux(1) & -fwxm(j,i) * & ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) & + ( 1.0 - fwxm(j,i) ) * wall_heatflux(3) & ) * ddx2 & + 0.5 * ( fwyp(j,i) * & ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) & - ( 1.0 - fwyp(j,i) ) * wall_heatflux(2) & -fwym(j,i) * & ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) & + ( 1.0 - fwym(j,i) ) * wall_heatflux(4) & ) * ddy2 ENDDO ENDIF ! !-- Compute vertical diffusion. In case that surface fluxes have been !-- presribed or computed, index k starts at nzb+2. DO k = nzb_diff_s_inner(j,i), nzt-1 tend(k,j,i) = tend(k,j,i) & + 0.5 * ( & ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) & - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) & ) * ddzw(k) ENDDO ! !-- Vertical diffusion at the first computational gridpoint in & !-- z-direction IF ( use_surface_fluxes ) THEN k = nzb_s_inner(j,i)+1 tend(k,j,i) = tend(k,j,i) & + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) & * ( s(k+1,j,i)-s(k,j,i) ) & * ddzu(k+1) & + s_flux(j,i) & ) * ddzw(k) ENDIF ENDDO ENDDO END SUBROUTINE diffusion_s !------------------------------------------------------------------------------! ! Call for grid point i,j !------------------------------------------------------------------------------! SUBROUTINE diffusion_s_ij( i, j, ddzu, ddzw, kh, s, s_flux, tend ) USE control_parameters USE grid_variables USE indices IMPLICIT NONE INTEGER :: i, j, k REAL :: vertical_gridspace REAL :: ddzu(1:nzt+1), ddzw(1:nzt) REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) REAL, DIMENSION(:,:), POINTER :: s_flux REAL, DIMENSION(:,:,:), POINTER :: kh, s ! !-- Compute horizontal diffusion DO k = nzb_s_outer(j,i)+1, nzt-1 tend(k,j,i) = tend(k,j,i) & + 0.5 * ( & ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) & - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) & ) * ddx2 & + 0.5 * ( & ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) & - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) & ) * ddy2 ENDDO ! !-- Apply prescribed horizontal wall heatflux where necessary IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) & THEN DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i) tend(k,j,i) = tend(k,j,i) & + 0.5 * ( fwxp(j,i) * & ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) & - ( 1.0 - fwxp(j,i) ) * wall_heatflux(1) & -fwxm(j,i) * & ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) & + ( 1.0 - fwxm(j,i) ) * wall_heatflux(3) & ) * ddx2 & + 0.5 * ( fwyp(j,i) * & ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) & - ( 1.0 - fwyp(j,i) ) * wall_heatflux(2) & -fwym(j,i) * & ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) & + ( 1.0 - fwym(j,i) ) * wall_heatflux(4) & ) * ddy2 ENDDO ENDIF ! !-- Compute vertical diffusion. In case that surface fluxes have been !-- presribed or computed, index k starts at nzb+2. DO k = nzb_diff_s_inner(j,i), nzt-1 tend(k,j,i) = tend(k,j,i) & + 0.5 * ( & ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) & - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) & ) * ddzw(k) ENDDO ! !-- Vertical diffusion at the first computational gridpoint in z-direction IF ( use_surface_fluxes ) THEN k = nzb_s_inner(j,i)+1 tend(k,j,i) = tend(k,j,i) & + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) & * ( s(k+1,j,i)-s(k,j,i) ) & * ddzu(k+1) & + s_flux(j,i) & ) * ddzw(k) ENDIF END SUBROUTINE diffusion_s_ij END MODULE diffusion_s_mod