Changeset 2118 for palm/trunk/SOURCE/diffusion_s.f90
- Timestamp:
- Jan 17, 2017 4:38:49 PM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/diffusion_s.f90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/diffusion_s.f90
r2101 r2118 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! OpenACC version of subroutine removed 23 23 ! 24 24 ! Former revisions: … … 34 34 ! 1873 2016-04-18 14:50:06Z maronga 35 35 ! Module renamed (removed _mod) 36 ! 37 ! 36 ! 38 37 ! 1850 2016-04-08 13:29:27Z maronga 39 38 ! Module renamed 40 !41 39 ! 42 40 ! 1691 2015-10-26 16:17:44Z maronga … … 94 92 95 93 PRIVATE 96 PUBLIC diffusion_s , diffusion_s_acc94 PUBLIC diffusion_s 97 95 98 96 INTERFACE diffusion_s … … 100 98 MODULE PROCEDURE diffusion_s_ij 101 99 END INTERFACE diffusion_s 102 103 INTERFACE diffusion_s_acc104 MODULE PROCEDURE diffusion_s_acc105 END INTERFACE diffusion_s_acc106 100 107 101 CONTAINS … … 242 236 ! Description: 243 237 ! ------------ 244 !> Call for all grid points - accelerator version245 !------------------------------------------------------------------------------!246 SUBROUTINE diffusion_s_acc( s, s_flux_b, s_flux_t, wall_s_flux )247 248 USE arrays_3d, &249 ONLY: ddzu, ddzw, kh, tend, drho_air, rho_air_zw250 251 USE control_parameters, &252 ONLY: use_surface_fluxes, use_top_fluxes253 254 USE grid_variables, &255 ONLY: ddx2, ddy2, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y256 257 USE indices, &258 ONLY: i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg, &259 nzb, nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, nzt, nzt_diff260 261 USE kinds262 263 IMPLICIT NONE264 265 INTEGER(iwp) :: i !<266 INTEGER(iwp) :: j !<267 INTEGER(iwp) :: k !<268 REAL(wp) :: wall_s_flux(0:4) !<269 REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_b !<270 REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) :: s_flux_t !<271 #if defined( __nopointer )272 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: s !<273 #else274 REAL(wp), DIMENSION(:,:,:), POINTER :: s !<275 #endif276 277 !$acc kernels present( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, kh ) &278 !$acc present( nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, s ) &279 !$acc present( s_flux_b, s_flux_t, tend, wall_s_flux ) &280 !$acc present( wall_w_x, wall_w_y )281 DO i = i_left, i_right282 DO j = j_south, j_north283 !284 !-- Compute horizontal diffusion285 DO k = 1, nzt286 IF ( k > nzb_s_outer(j,i) ) THEN287 288 tend(k,j,i) = tend(k,j,i) &289 + 0.5_wp * ( &290 ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &291 - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &292 ) * ddx2 &293 + 0.5_wp * ( &294 ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &295 - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &296 ) * ddy2297 ENDIF298 ENDDO299 300 !301 !-- Apply prescribed horizontal wall heatflux where necessary302 DO k = 1, nzt303 IF ( k > nzb_s_inner(j,i) .AND. k <= nzb_s_outer(j,i) .AND. &304 ( wall_w_x(j,i) /= 0.0_wp .OR. wall_w_y(j,i) /= 0.0_wp ) ) &305 THEN306 tend(k,j,i) = tend(k,j,i) &307 + ( fwxp(j,i) * 0.5_wp * &308 ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &309 + ( 1.0_wp - fwxp(j,i) ) * wall_s_flux(1) &310 -fwxm(j,i) * 0.5_wp * &311 ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &312 + ( 1.0_wp - fwxm(j,i) ) * wall_s_flux(2) &313 ) * ddx2 &314 + ( fwyp(j,i) * 0.5_wp * &315 ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &316 + ( 1.0_wp - fwyp(j,i) ) * wall_s_flux(3) &317 -fwym(j,i) * 0.5_wp * &318 ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &319 + ( 1.0_wp - fwym(j,i) ) * wall_s_flux(4) &320 ) * ddy2321 ENDIF322 ENDDO323 324 !325 !-- Compute vertical diffusion. In case that surface fluxes have been326 !-- prescribed or computed at bottom and/or top, index k starts/ends at327 !-- nzb+2 or nzt-1, respectively.328 DO k = 1, nzt_diff329 IF ( k >= nzb_diff_s_inner(j,i) ) THEN330 tend(k,j,i) = tend(k,j,i) &331 + 0.5_wp * ( &332 ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &333 * rho_air_zw(k) &334 - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &335 * rho_air_zw(k-1) &336 ) * ddzw(k) * drho_air(k)337 ENDIF338 ENDDO339 340 !341 !-- Vertical diffusion at the first computational gridpoint along342 !-- z-direction343 DO k = 1, nzt344 IF ( use_surface_fluxes .AND. k == nzb_s_inner(j,i)+1 ) THEN345 tend(k,j,i) = tend(k,j,i) &346 + ( 0.5_wp * ( kh(k,j,i)+kh(k+1,j,i) )&347 * ( s(k+1,j,i)-s(k,j,i) ) &348 * ddzu(k+1) &349 * rho_air_zw(k) &350 + s_flux_b(j,i) &351 ) * ddzw(k) * drho_air(k)352 ENDIF353 354 !355 !-- Vertical diffusion at the last computational gridpoint along356 !-- z-direction357 IF ( use_top_fluxes .AND. k == nzt ) THEN358 tend(k,j,i) = tend(k,j,i) &359 + ( - s_flux_t(j,i) &360 - 0.5_wp * ( kh(k-1,j,i)+kh(k,j,i) )&361 * ( s(k,j,i)-s(k-1,j,i) ) &362 * ddzu(k) &363 * rho_air_zw(k-1) &364 ) * ddzw(k) * drho_air(k)365 ENDIF366 ENDDO367 368 ENDDO369 ENDDO370 !$acc end kernels371 372 END SUBROUTINE diffusion_s_acc373 374 375 !------------------------------------------------------------------------------!376 ! Description:377 ! ------------378 238 !> Call for grid point i,j 379 239 !------------------------------------------------------------------------------!
Note: See TracChangeset
for help on using the changeset viewer.
