Changeset 2118 for palm/trunk/SOURCE/diffusion_e.f90
- Timestamp:
- Jan 17, 2017 4:38:49 PM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/diffusion_e.f90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/diffusion_e.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 … … 108 107 109 108 PRIVATE 110 PUBLIC diffusion_e , diffusion_e_acc109 PUBLIC diffusion_e 111 110 112 111 … … 116 115 END INTERFACE diffusion_e 117 116 118 INTERFACE diffusion_e_acc119 MODULE PROCEDURE diffusion_e_acc120 END INTERFACE diffusion_e_acc121 122 117 CONTAINS 123 118 … … 337 332 338 333 END SUBROUTINE diffusion_e 339 340 341 !------------------------------------------------------------------------------!342 ! Description:343 ! ------------344 !> Call for all grid points - accelerator version345 !------------------------------------------------------------------------------!346 SUBROUTINE diffusion_e_acc( var, var_reference )347 348 USE arrays_3d, &349 ONLY: dd2zu, ddzu, ddzw, diss, e, km, l_grid, tend, zu, zw, &350 drho_air, rho_air_zw351 352 USE control_parameters, &353 ONLY: atmos_ocean_sign, g, use_single_reference_value, &354 wall_adjustment, wall_adjustment_factor355 356 USE grid_variables, &357 ONLY: ddx2, ddy2358 359 USE indices, &360 ONLY: i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg, &361 nzb, nzb_s_inner, nzt362 363 USE kinds364 365 USE microphysics_mod, &366 ONLY: collision_turbulence367 368 USE particle_attributes, &369 ONLY: use_sgs_for_particles, wang_kernel370 371 IMPLICIT NONE372 373 INTEGER(iwp) :: i !<374 INTEGER(iwp) :: j !<375 INTEGER(iwp) :: k !<376 REAL(wp) :: dissipation !<377 REAL(wp) :: dvar_dz !<378 REAL(wp) :: l !<379 REAL(wp) :: ll !<380 REAL(wp) :: l_stable !<381 REAL(wp) :: var_reference !<382 383 #if defined( __nopointer )384 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !<385 #else386 REAL(wp), DIMENSION(:,:,:), POINTER :: var !<387 #endif388 389 390 !391 !-- This if clause must be outside the k-loop because otherwise392 !-- runtime errors occur with -C hopt on NEC393 IF ( use_single_reference_value ) THEN394 395 !$acc kernels present( ddzu, ddzw, dd2zu, diss, e, km, l_grid ) &396 !$acc present( nzb_s_inner, tend, var, zu, zw )397 DO i = i_left, i_right398 DO j = j_south, j_north399 DO k = 1, nzt400 401 IF ( k > nzb_s_inner(j,i) ) THEN402 !403 !-- Calculate the mixing length (for dissipation)404 dvar_dz = atmos_ocean_sign * &405 ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)406 IF ( dvar_dz > 0.0_wp ) THEN407 l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &408 SQRT( g / var_reference * dvar_dz ) + 1E-5_wp409 ELSE410 l_stable = l_grid(k)411 ENDIF412 !413 !-- Adjustment of the mixing length414 IF ( wall_adjustment ) THEN415 l = MIN( wall_adjustment_factor * &416 ( zu(k) - zw(nzb_s_inner(j,i)) ), &417 l_grid(k), l_stable )418 ll = MIN( wall_adjustment_factor * &419 ( zu(k) - zw(nzb_s_inner(j,i)) ), &420 l_grid(k) )421 ELSE422 l = MIN( l_grid(k), l_stable )423 ll = l_grid(k)424 ENDIF425 !426 !-- Calculate the tendency terms427 dissipation = ( 0.19_wp + 0.74_wp * l / ll ) * &428 e(k,j,i) * SQRT( e(k,j,i) ) / l429 430 tend(k,j,i) = tend(k,j,i) &431 + ( &432 ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) ) &433 - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) ) &434 ) * ddx2 &435 + ( &436 ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) ) &437 - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) ) &438 ) * ddy2 &439 + ( &440 ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &441 * rho_air_zw(k) &442 - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k) &443 * rho_air_zw(k-1) &444 ) * ddzw(k) * drho_air(k) &445 - dissipation446 447 !448 !-- Store dissipation if needed for calculating the sgs particle449 !-- velocities450 IF ( use_sgs_for_particles .OR. wang_kernel .OR. &451 collision_turbulence ) THEN452 diss(k,j,i) = dissipation453 ENDIF454 455 ENDIF456 457 ENDDO458 ENDDO459 ENDDO460 !$acc end kernels461 462 ELSE463 464 !$acc kernels present( ddzu, ddzw, dd2zu, diss, e, km, l_grid ) &465 !$acc present( nzb_s_inner, tend, var, zu, zw )466 DO i = i_left, i_right467 DO j = j_south, j_north468 DO k = 1, nzt469 470 IF ( k > nzb_s_inner(j,i) ) THEN471 !472 !-- Calculate the mixing length (for dissipation)473 dvar_dz = atmos_ocean_sign * &474 ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)475 IF ( dvar_dz > 0.0_wp ) THEN476 l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &477 SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp478 ELSE479 l_stable = l_grid(k)480 ENDIF481 !482 !-- Adjustment of the mixing length483 IF ( wall_adjustment ) THEN484 l = MIN( wall_adjustment_factor * &485 ( zu(k) - zw(nzb_s_inner(j,i)) ), &486 l_grid(k), l_stable )487 ll = MIN( wall_adjustment_factor * &488 ( zu(k) - zw(nzb_s_inner(j,i)) ), &489 l_grid(k) )490 ELSE491 l = MIN( l_grid(k), l_stable )492 ll = l_grid(k)493 ENDIF494 !495 !-- Calculate the tendency terms496 dissipation = ( 0.19_wp + 0.74_wp * l / ll ) * &497 e(k,j,i) * SQRT( e(k,j,i) ) / l498 499 tend(k,j,i) = tend(k,j,i) &500 + ( &501 ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) ) &502 - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) ) &503 ) * ddx2 &504 + ( &505 ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) ) &506 - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) ) &507 ) * ddy2 &508 + ( &509 ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &510 * rho_air_zw(k) &511 - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k) &512 * rho_air_zw(k-1) &513 ) * ddzw(k) * drho_air(k) &514 - dissipation515 516 !517 !-- Store dissipation if needed for calculating the sgs518 !-- particle velocities519 IF ( use_sgs_for_particles .OR. wang_kernel .OR. &520 collision_turbulence ) THEN521 diss(k,j,i) = dissipation522 ENDIF523 524 ENDIF525 526 ENDDO527 ENDDO528 ENDDO529 !$acc end kernels530 531 ENDIF532 533 !534 !-- Boundary condition for dissipation535 IF ( use_sgs_for_particles .OR. wang_kernel .OR. &536 collision_turbulence ) THEN537 !$acc kernels present( diss, nzb_s_inner )538 DO i = i_left, i_right539 DO j = j_south, j_north540 diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)541 ENDDO542 ENDDO543 !$acc end kernels544 ENDIF545 546 END SUBROUTINE diffusion_e_acc547 334 548 335
Note: See TracChangeset
for help on using the changeset viewer.
