Changeset 2118 for palm/trunk/SOURCE/diffusion_w.f90
- Timestamp:
- Jan 17, 2017 4:38:49 PM (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/diffusion_w.f90
r2101 r2118 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! OpenACC version of subroutine removed 23 23 ! 24 24 ! Former revisions: … … 35 35 ! Module renamed (removed _mod) 36 36 ! 37 !38 37 ! 1850 2016-04-08 13:29:27Z maronga 39 38 ! Module renamed 40 !41 39 ! 42 40 ! 1682 2015-10-07 23:56:08Z knoop … … 97 95 98 96 USE wall_fluxes_mod, & 99 ONLY : wall_fluxes , wall_fluxes_acc97 ONLY : wall_fluxes 100 98 101 99 PRIVATE 102 PUBLIC diffusion_w , diffusion_w_acc100 PUBLIC diffusion_w 103 101 104 102 INTERFACE diffusion_w … … 106 104 MODULE PROCEDURE diffusion_w_ij 107 105 END INTERFACE diffusion_w 108 109 INTERFACE diffusion_w_acc110 MODULE PROCEDURE diffusion_w_acc111 END INTERFACE diffusion_w_acc112 106 113 107 CONTAINS … … 248 242 ! Description: 249 243 ! ------------ 250 !> Call for all grid points - accelerator version251 !------------------------------------------------------------------------------!252 SUBROUTINE diffusion_w_acc253 254 USE arrays_3d, &255 ONLY : ddzu, ddzw, km, tend, u, v, w, drho_air_zw, rho_air256 257 USE control_parameters, &258 ONLY : topography259 260 USE grid_variables, &261 ONLY : ddx, ddy, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y262 263 USE indices, &264 ONLY : i_left, i_right, j_north, j_south, nxl, nxr, nyn, nys, nzb, &265 nzb_w_inner, nzb_w_outer, nzt266 267 USE kinds268 269 IMPLICIT NONE270 271 INTEGER(iwp) :: i !<272 INTEGER(iwp) :: j !<273 INTEGER(iwp) :: k !<274 275 REAL(wp) :: kmxm !<276 REAL(wp) :: kmxp !<277 REAL(wp) :: kmym !<278 REAL(wp) :: kmyp !<279 280 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus !<281 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsvs !<282 !$acc declare create ( wsus, wsvs )283 284 !285 !-- First calculate horizontal momentum flux w'u' and/or w'v' at vertical286 !-- walls, if neccessary287 IF ( topography /= 'flat' ) THEN288 CALL wall_fluxes_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, &289 nzb_w_inner, nzb_w_outer, wall_w_x )290 CALL wall_fluxes_acc( wsvs, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, &291 nzb_w_inner, nzb_w_outer, wall_w_y )292 ENDIF293 294 !$acc kernels present ( u, v, w, km, tend ) &295 !$acc present ( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y ) &296 !$acc present ( nzb_w_inner, nzb_w_outer )297 DO i = i_left, i_right298 DO j = j_south, j_north299 DO k = 1, nzt300 IF ( k > nzb_w_outer(j,i) ) THEN301 !302 !-- Interpolate eddy diffusivities on staggered gridpoints303 kmxp = 0.25_wp * &304 ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )305 kmxm = 0.25_wp * &306 ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )307 kmyp = 0.25_wp * &308 ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )309 kmym = 0.25_wp * &310 ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )311 312 tend(k,j,i) = tend(k,j,i) &313 & + ( kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &314 & + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &315 & - kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &316 & - kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &317 & ) * ddx &318 & + ( kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &319 & + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &320 & - kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &321 & - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &322 & ) * ddy &323 & + 2.0_wp * ( &324 & km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &325 & * rho_air(k+1) &326 & - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &327 & * rho_air(k) &328 & ) * ddzu(k+1) * drho_air_zw(k)329 ENDIF330 ENDDO331 332 !333 !-- Wall functions at all vertical walls, where necessary334 DO k = 1,nzt335 336 IF ( k > nzb_w_inner(j,i) .AND. k <= nzb_w_outer(j,i) .AND. &337 wall_w_x(j,i) /= 0.0_wp .AND. wall_w_y(j,i) /= 0.0_wp ) THEN338 !339 !-- Interpolate eddy diffusivities on staggered gridpoints340 kmxp = 0.25_wp * &341 ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )342 kmxm = 0.25_wp * &343 ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )344 kmyp = 0.25_wp * &345 ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )346 kmym = 0.25_wp * &347 ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )348 349 tend(k,j,i) = tend(k,j,i) &350 + ( fwxp(j,i) * ( &351 kmxp * ( w(k,j,i+1) - w(k,j,i) ) * ddx &352 + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &353 ) &354 - fwxm(j,i) * ( &355 kmxm * ( w(k,j,i) - w(k,j,i-1) ) * ddx &356 + kmxm * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &357 ) &358 + wall_w_x(j,i) * wsus(k,j,i) &359 ) * ddx &360 + ( fwyp(j,i) * ( &361 kmyp * ( w(k,j+1,i) - w(k,j,i) ) * ddy &362 + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &363 ) &364 - fwym(j,i) * ( &365 kmym * ( w(k,j,i) - w(k,j-1,i) ) * ddy &366 + kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &367 ) &368 + wall_w_y(j,i) * wsvs(k,j,i) &369 ) * ddy &370 + 2.0_wp * ( &371 km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &372 * rho_air(k+1) &373 - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &374 * rho_air(k) &375 ) * ddzu(k+1) * drho_air_zw(k)376 ENDIF377 ENDDO378 379 ENDDO380 ENDDO381 !$acc end kernels382 383 END SUBROUTINE diffusion_w_acc384 385 386 !------------------------------------------------------------------------------!387 ! Description:388 ! ------------389 244 !> Call for grid point i,j 390 245 !------------------------------------------------------------------------------!
Note: See TracChangeset
for help on using the changeset viewer.