MODULE diffusion_s_mod !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Log: diffusion_s.f90,v $ ! 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.7 2004/01/30 10:20:56 raasch ! Scalar lower k index nzb replaced by 2d-array nzb_2d ! ! Revision 1.6 2003/03/12 16:25:32 raasch ! Full code replaced in the call for all gridpoints instead of calling the ! _ij version (required by NEC, because otherwise no vectorization) ! ! Revision 1.5 2002/06/11 12:52:41 raasch ! Former subroutine changed to a module which allows to be called for all grid ! points of a single vertical column with index i,j or for all grid points by ! using function overloading. ! ! Revision 1.4 2001/03/30 07:11:44 raasch ! Translation of remaining German identifiers (variables, subroutines, etc.) ! ! Revision 1.3 2001/01/25 06:58:14 raasch ! Variable "prandtl_layer replaced by "use_surface_fluxes" ! ! Revision 1.2 2000/07/03 12:57:13 raasch ! dummy arguments, whose corresponding actual arguments are pointers, ! are now also defined as pointers, ! all comments translated into English ! ! 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