MODULE diffusion_s_mod !------------------------------------------------------------------------------! ! Current revisions: ! ------------------ ! ! ! Former revisions: ! ----------------- ! $Id: diffusion_s.f90 1017 2012-09-27 11:28:50Z suehring $ ! ! 1015 2012-09-27 09:23:24Z raasch ! accelerator version (*_acc) added ! ! 1010 2012-09-20 07:59:54Z raasch ! cpp switch __nopointer added for pointer free version ! ! 1001 2012-09-13 14:08:46Z raasch ! some arrays comunicated by module instead of parameter list ! ! 667 2010-12-23 12:06:00Z suehring/gryschka ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng ! ! 183 2008-08-04 15:39:12Z letzel ! bugfix: calculation of fluxes at vertical surfaces ! ! 129 2007-10-30 12:12:24Z letzel ! replace wall_heatflux by wall_s_flux that is now included in the parameter ! list, bugfix for assignment of fluxes at walls ! ! 20 2007-02-26 00:12:32Z raasch ! Bugfix: ddzw dimensioned 1:nzt"+1" ! Calculation extended for gridpoint nzt, fluxes can be given at top, ! +s_flux_t in parameter list, s_flux renamed s_flux_b ! ! 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, diffusion_s_acc INTERFACE diffusion_s MODULE PROCEDURE diffusion_s MODULE PROCEDURE diffusion_s_ij END INTERFACE diffusion_s INTERFACE diffusion_s_acc MODULE PROCEDURE diffusion_s_acc END INTERFACE diffusion_s_acc CONTAINS !------------------------------------------------------------------------------! ! Call for all grid points !------------------------------------------------------------------------------! SUBROUTINE diffusion_s( s, s_flux_b, s_flux_t, wall_s_flux ) USE arrays_3d USE control_parameters USE grid_variables USE indices IMPLICIT NONE INTEGER :: i, j, k REAL :: vertical_gridspace REAL :: wall_s_flux(0:4) REAL, DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_b, s_flux_t #if defined( __nopointer ) REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s #else REAL, DIMENSION(:,:,:), POINTER :: s #endif DO i = nxl, nxr DO j = nys,nyn ! !-- Compute horizontal diffusion DO k = nzb_s_outer(j,i)+1, nzt 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) & + ( fwxp(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) & + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1) & -fwxm(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) & + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2) & ) * ddx2 & + ( fwyp(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) & + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3) & -fwym(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) & + ( 1.0 - fwym(j,i) ) * wall_s_flux(4) & ) * ddy2 ENDDO ENDIF ! !-- Compute vertical diffusion. In case that surface fluxes have been !-- prescribed or computed at bottom and/or top, index k starts/ends at !-- nzb+2 or nzt-1, respectively. DO k = nzb_diff_s_inner(j,i), nzt_diff 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 along !-- 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_b(j,i) & ) * ddzw(k) ENDIF ! !-- Vertical diffusion at the last computational gridpoint along !-- z-direction IF ( use_top_fluxes ) THEN k = nzt tend(k,j,i) = tend(k,j,i) & + ( - s_flux_t(j,i) & - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) ) & * ( s(k,j,i)-s(k-1,j,i) ) & * ddzu(k) & ) * ddzw(k) ENDIF ENDDO ENDDO END SUBROUTINE diffusion_s !------------------------------------------------------------------------------! ! Call for all grid points - accelerator version !------------------------------------------------------------------------------! SUBROUTINE diffusion_s_acc( s, s_flux_b, s_flux_t, wall_s_flux ) USE arrays_3d USE control_parameters USE grid_variables USE indices IMPLICIT NONE INTEGER :: i, j, k REAL :: vertical_gridspace REAL :: wall_s_flux(0:4) REAL, DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_b, s_flux_t #if defined( __nopointer ) REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s #else REAL, DIMENSION(:,:,:), POINTER :: s #endif !$acc kernels present( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, kh ) & !$acc present( nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, s ) & !$acc present( s_flux_b, s_flux_t, tend, wall_s_flux ) & !$acc present( wall_w_x, wall_w_y ) !$acc loop DO i = nxl, nxr DO j = nys,nyn ! !-- Compute horizontal diffusion !$acc loop vector( 32 ) DO k = 1, nzt IF ( k > nzb_s_outer(j,i) ) THEN 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 ENDIF ENDDO ! !-- Apply prescribed horizontal wall heatflux where necessary !$acc loop vector(32) DO k = 1, nzt IF ( k > nzb_s_inner(j,i) .AND. k <= nzb_s_outer(j,i) .AND. & ( wall_w_x(j,i) /= 0.0 .OR. wall_w_y(j,i) /= 0.0 ) ) & THEN tend(k,j,i) = tend(k,j,i) & + ( fwxp(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) & + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1) & -fwxm(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) & + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2) & ) * ddx2 & + ( fwyp(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) & + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3) & -fwym(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) & + ( 1.0 - fwym(j,i) ) * wall_s_flux(4) & ) * ddy2 ENDIF ENDDO ! !-- Compute vertical diffusion. In case that surface fluxes have been !-- prescribed or computed at bottom and/or top, index k starts/ends at !-- nzb+2 or nzt-1, respectively. !$acc loop vector( 32 ) DO k = 1, nzt_diff IF ( k >= nzb_diff_s_inner(j,i) ) THEN 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) ENDIF ENDDO ! !-- Vertical diffusion at the first computational gridpoint along !-- z-direction !$acc loop vector( 32 ) DO k = 1, nzt IF ( use_surface_fluxes .AND. k == nzb_s_inner(j,i)+1 ) THEN 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_b(j,i) & ) * ddzw(k) ENDIF ! !-- Vertical diffusion at the last computational gridpoint along !-- z-direction IF ( use_top_fluxes .AND. k == nzt ) THEN tend(k,j,i) = tend(k,j,i) & + ( - s_flux_t(j,i) & - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )& * ( s(k,j,i)-s(k-1,j,i) ) & * ddzu(k) & ) * ddzw(k) ENDIF ENDDO ENDDO ENDDO !$acc end kernels END SUBROUTINE diffusion_s_acc !------------------------------------------------------------------------------! ! Call for grid point i,j !------------------------------------------------------------------------------! SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux ) USE arrays_3d USE control_parameters USE grid_variables USE indices IMPLICIT NONE INTEGER :: i, j, k REAL :: vertical_gridspace REAL :: wall_s_flux(0:4) REAL, DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_b, s_flux_t #if defined( __nopointer ) REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s #else REAL, DIMENSION(:,:,:), POINTER :: s #endif ! !-- Compute horizontal diffusion DO k = nzb_s_outer(j,i)+1, nzt 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) & + ( fwxp(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) & + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1) & -fwxm(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) & + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2) & ) * ddx2 & + ( fwyp(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) & + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3) & -fwym(j,i) * 0.5 * & ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) & + ( 1.0 - fwym(j,i) ) * wall_s_flux(4) & ) * ddy2 ENDDO ENDIF ! !-- Compute vertical diffusion. In case that surface fluxes have been !-- prescribed or computed at bottom and/or top, index k starts/ends at !-- nzb+2 or nzt-1, respectively. DO k = nzb_diff_s_inner(j,i), nzt_diff 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 along 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_b(j,i) & ) * ddzw(k) ENDIF ! !-- Vertical diffusion at the last computational gridpoint along z-direction IF ( use_top_fluxes ) THEN k = nzt tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i) & - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) ) & * ( s(k,j,i)-s(k-1,j,i) ) & * ddzu(k) & ) * ddzw(k) ENDIF END SUBROUTINE diffusion_s_ij END MODULE diffusion_s_mod