- Timestamp:
- Dec 18, 2018 12:31:28 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 1 added
- 23 edited
-
Makefile (modified) (4 diffs)
-
advec_ws.f90 (modified) (80 diffs)
-
basic_constants_and_equations_mod.f90 (modified) (2 diffs)
-
boundary_conds.f90 (modified) (8 diffs)
-
buoyancy.f90 (modified) (2 diffs)
-
coriolis.f90 (modified) (4 diffs)
-
cuda_fft_interfaces.f90 (added)
-
diffusion_s.f90 (modified) (2 diffs)
-
diffusion_u.f90 (modified) (2 diffs)
-
diffusion_v.f90 (modified) (2 diffs)
-
diffusion_w.f90 (modified) (2 diffs)
-
exchange_horiz.f90 (modified) (4 diffs)
-
fft_xy_mod.f90 (modified) (9 diffs)
-
poisfft_mod.f90 (modified) (6 diffs)
-
pres.f90 (modified) (15 diffs)
-
prognostic_equations.f90 (modified) (17 diffs)
-
surface_layer_fluxes_mod.f90 (modified) (19 diffs)
-
surface_mod.f90 (modified) (7 diffs)
-
time_integration.f90 (modified) (11 diffs)
-
timestep.f90 (modified) (5 diffs)
-
timestep_scheme_steering.f90 (modified) (2 diffs)
-
transpose.f90 (modified) (31 diffs)
-
tridia_solver_mod.f90 (modified) (8 diffs)
-
turbulence_closure_mod.f90 (modified) (43 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r3579 r3634 25 25 # ----------------- 26 26 # $Id$ 27 # OpenACC port for SPEC 28 # 29 # 3579 2018-11-29 15:32:39Z suehring 27 30 # Dependency for check_parameters on nesting_offl_mod added 28 31 # … … 554 557 coriolis.f90 \ 555 558 cpulog_mod.f90 \ 559 cuda_fft_interfaces.f90 \ 556 560 data_log.f90 \ 557 561 data_output_2d.f90 \ … … 919 923 mod_kinds.o \ 920 924 modules.o 925 cuda_fft_interfaces.o: \ 926 cuda_fft_interfaces.f90 \ 927 modules.o \ 928 mod_kinds.o 921 929 data_log.o: \ 922 930 mod_kinds.o \ … … 1042 1050 pmc_interface_mod.o 1043 1051 fft_xy_mod.o: \ 1052 cuda_fft_interfaces.o \ 1044 1053 mod_kinds.o \ 1045 1054 modules.o \ -
palm/trunk/SOURCE/advec_ws.f90
r3589 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3589 2018-11-30 15:09:51Z suehring 27 30 ! Move the control parameter "salsa" from salsa_mod to control_parameters 28 31 ! (M. Kurppa) … … 1143 1146 !-- beginning of prognostic_equations. 1144 1147 IF ( ws_scheme_mom ) THEN 1148 !$ACC KERNELS PRESENT(sums_wsus_ws_l, sums_wsvs_ws_l) & 1149 !$ACC PRESENT(sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l) 1145 1150 sums_wsus_ws_l = 0.0_wp 1146 1151 sums_wsvs_ws_l = 0.0_wp … … 1148 1153 sums_vs2_ws_l = 0.0_wp 1149 1154 sums_ws2_ws_l = 0.0_wp 1155 !$ACC END KERNELS 1150 1156 ENDIF 1151 1157 1152 1158 IF ( ws_scheme_sca ) THEN 1159 !$ACC KERNELS PRESENT(sums_wspts_ws_l) 1153 1160 sums_wspts_ws_l = 0.0_wp 1161 !$ACC END KERNELS 1154 1162 IF ( humidity ) sums_wsqs_ws_l = 0.0_wp 1155 1163 IF ( passive_scalar ) sums_wsss_ws_l = 0.0_wp … … 3300 3308 3301 3309 CHARACTER (LEN = *), INTENT(IN) :: sk_char !< string identifier, used for assign fluxes to the correct dimension in the analysis array 3310 INTEGER(iwp) :: sk_num !< integer identifier, used for assign fluxes to the correct dimension in the analysis array 3302 3311 3303 3312 INTEGER(iwp) :: i !< grid index along x-direction … … 3320 3329 REAL(wp) :: ibit1 !< flag indicating 3rd-order scheme along x-direction 3321 3330 REAL(wp) :: ibit2 !< flag indicating 5th-order scheme along x-direction 3331 #ifdef _OPENACC 3332 REAL(wp) :: ibit0_l !< flag indicating 1st-order scheme along x-direction 3333 REAL(wp) :: ibit1_l !< flag indicating 3rd-order scheme along x-direction 3334 REAL(wp) :: ibit2_l !< flag indicating 5th-order scheme along x-direction 3335 #endif 3322 3336 REAL(wp) :: ibit3 !< flag indicating 1st-order scheme along y-direction 3323 3337 REAL(wp) :: ibit4 !< flag indicating 3rd-order scheme along y-direction 3324 3338 REAL(wp) :: ibit5 !< flag indicating 5th-order scheme along y-direction 3339 #ifdef _OPENACC 3340 REAL(wp) :: ibit3_s !< flag indicating 1st-order scheme along y-direction 3341 REAL(wp) :: ibit4_s !< flag indicating 3rd-order scheme along y-direction 3342 REAL(wp) :: ibit5_s !< flag indicating 5th-order scheme along y-direction 3343 #endif 3325 3344 REAL(wp) :: ibit6 !< flag indicating 1st-order scheme along z-direction 3326 3345 REAL(wp) :: ibit7 !< flag indicating 3rd-order scheme along z-direction … … 3330 3349 REAL(wp) :: flux_d !< 6th-order flux at grid box bottom 3331 3350 REAL(wp) :: u_comp !< advection velocity along x-direction 3351 #ifdef _OPENACC 3352 REAL(wp) :: u_comp_l !< advection velocity along x-direction 3353 #endif 3332 3354 REAL(wp) :: v_comp !< advection velocity along y-direction 3355 #ifdef _OPENACC 3356 REAL(wp) :: v_comp_s !< advection velocity along y-direction 3357 #endif 3333 3358 3334 REAL(wp) , DIMENSION(nzb:nzt):: diss_n !< discretized artificial dissipation at northward-side of the grid box3335 REAL(wp) , DIMENSION(nzb:nzt):: diss_r !< discretized artificial dissipation at rightward-side of the grid box3336 REAL(wp) , DIMENSION(nzb:nzt):: diss_t !< discretized artificial dissipation at rightward-side of the grid box3337 REAL(wp) , DIMENSION(nzb:nzt):: flux_n !< discretized 6th-order flux at northward-side of the grid box3338 REAL(wp) , DIMENSION(nzb:nzt):: flux_r !< discretized 6th-order flux at rightward-side of the grid box3339 REAL(wp) , DIMENSION(nzb:nzt):: flux_t !< discretized 6th-order flux at rightward-side of the grid box3359 REAL(wp) :: diss_n !< discretized artificial dissipation at northward-side of the grid box 3360 REAL(wp) :: diss_r !< discretized artificial dissipation at rightward-side of the grid box 3361 REAL(wp) :: diss_t !< discretized artificial dissipation at rightward-side of the grid box 3362 REAL(wp) :: flux_n !< discretized 6th-order flux at northward-side of the grid box 3363 REAL(wp) :: flux_r !< discretized 6th-order flux at rightward-side of the grid box 3364 REAL(wp) :: flux_t !< discretized 6th-order flux at rightward-side of the grid box 3340 3365 3366 REAL(wp) :: diss_s !< discretized artificial dissipation term at southward-side of the grid box 3367 REAL(wp) :: flux_s !< discretized 6th-order flux at northward-side of the grid box 3368 #ifndef _OPENACC 3341 3369 REAL(wp), DIMENSION(nzb+1:nzt) :: swap_diss_y_local !< discretized artificial dissipation term at southward-side of the grid box 3342 3370 REAL(wp), DIMENSION(nzb+1:nzt) :: swap_flux_y_local !< discretized 6th-order flux at northward-side of the grid box 3371 #endif 3343 3372 3373 REAL(wp) :: diss_l !< discretized artificial dissipation term at leftward-side of the grid box 3374 REAL(wp) :: flux_l !< discretized 6th-order flux at leftward-side of the grid box 3375 #ifndef _OPENACC 3344 3376 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local !< discretized artificial dissipation term at leftward-side of the grid box 3345 3377 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_flux_x_local !< discretized 6th-order flux at leftward-side of the grid box 3378 #endif 3346 3379 3347 3380 SELECT CASE ( sk_char ) 3381 3382 CASE ( 'pt' ) 3383 sk_num = 1 3384 CASE ( 'sa' ) 3385 sk_num = 2 3386 CASE ( 'q' ) 3387 sk_num = 3 3388 CASE ( 'qc' ) 3389 sk_num = 4 3390 CASE ( 'qr' ) 3391 sk_num = 5 3392 CASE ( 'nc' ) 3393 sk_num = 6 3394 CASE ( 'nr' ) 3395 sk_num = 7 3396 CASE ( 's' ) 3397 sk_num = 8 3398 CASE ( 'aerosol_mass', 'aerosol_number', 'salsa_gas' ) 3399 sk_num = 9 3400 3401 END SELECT 3402 3403 #ifndef _OPENACC 3348 3404 ! 3349 3405 !-- Compute the fluxes for the whole left boundary of the processor domain. … … 3408 3464 3409 3465 ENDDO 3410 3466 #endif 3467 3468 !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, sk_num) & 3469 !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) & 3470 !$ACC PRIVATE(ibit0, ibit1, ibit2, ibit3, ibit4, ibit5) & 3471 !$ACC PRIVATE(ibit0_l, ibit1_l, ibit2_l) & 3472 !$ACC PRIVATE(ibit3_s, ibit4_s, ibit5_s) & 3473 !$ACC PRIVATE(ibit6, ibit7, ibit8) & 3474 !$ACC PRIVATE(flux_r, diss_r, flux_l, diss_l) & 3475 !$ACC PRIVATE(flux_n, diss_n, flux_s, diss_s) & 3476 !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) & 3477 !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s) & 3478 !$ACC PRESENT(advc_flags_1) & 3479 !$ACC PRESENT(sk, u, v, w, u_stokes_zu, v_stokes_zu) & 3480 !$ACC PRESENT(drho_air, rho_air_zw, ddzw) & 3481 !$ACC PRESENT(tend) & 3482 !$ACC PRESENT(hom(nzb+1:nzb_max,1,1:3,0)) & 3483 !$ACC PRESENT(weight_substep(intermediate_timestep_count)) & 3484 !$ACC PRESENT(sums_wspts_ws_l, sums_wssas_ws_l) & 3485 !$ACC PRESENT(sums_wsqs_ws_l, sums_wsqcs_ws_l) & 3486 !$ACC PRESENT(sums_wsqrs_ws_l, sums_wsncs_ws_l) & 3487 !$ACC PRESENT(sums_wsnrs_ws_l, sums_wsss_ws_l) & 3488 !$ACC PRESENT(sums_salsa_ws_l) 3411 3489 DO i = nxl, nxr 3412 3490 3491 #ifndef _OPENACC 3413 3492 j = nys 3414 3493 DO k = nzb+1, nzb_max … … 3467 3546 3468 3547 ENDDO 3548 #endif 3469 3549 3470 3550 DO j = nys, nyn 3471 3551 3472 flux_t(0) = 0.0_wp3473 diss_t(0) = 0.0_wp3474 3552 flux_d = 0.0_wp 3475 3553 diss_d = 0.0_wp … … 3481 3559 ibit0 = REAL( IBITS(advc_flags_1(k,j,i),0,1), KIND = wp ) 3482 3560 3483 u_comp 3484 flux_r (k) = u_comp * (&3561 u_comp = u(k,j,i+1) - u_gtrans + u_stokes_zu(k) 3562 flux_r = u_comp * ( & 3485 3563 ( 37.0_wp * ibit2 * adv_sca_5 & 3486 3564 + 7.0_wp * ibit1 * adv_sca_3 & … … 3497 3575 ) 3498 3576 3499 diss_r (k) = -ABS( u_comp ) * (&3577 diss_r = -ABS( u_comp ) * ( & 3500 3578 ( 10.0_wp * ibit2 * adv_sca_5 & 3501 3579 + 3.0_wp * ibit1 * adv_sca_3 & … … 3512 3590 ) 3513 3591 3592 #ifdef _OPENACC 3593 ! 3594 !-- Recompute the left fluxes. 3595 ibit2_l = REAL( IBITS(advc_flags_1(k,j,i-1),2,1), KIND = wp ) 3596 ibit1_l = REAL( IBITS(advc_flags_1(k,j,i-1),1,1), KIND = wp ) 3597 ibit0_l = REAL( IBITS(advc_flags_1(k,j,i-1),0,1), KIND = wp ) 3598 3599 u_comp_l = u(k,j,i) - u_gtrans + u_stokes_zu(k) 3600 flux_l = u_comp_l * ( & 3601 ( 37.0_wp * ibit2_l * adv_sca_5 & 3602 + 7.0_wp * ibit1_l * adv_sca_3 & 3603 + ibit0_l * adv_sca_1 & 3604 ) * & 3605 ( sk(k,j,i) + sk(k,j,i-1) ) & 3606 - ( 8.0_wp * ibit2_l * adv_sca_5 & 3607 + ibit1_l * adv_sca_3 & 3608 ) * & 3609 ( sk(k,j,i+1) + sk(k,j,i-2) ) & 3610 + ( ibit2_l * adv_sca_5 & 3611 ) * & 3612 ( sk(k,j,i+2) + sk(k,j,i-3) ) & 3613 ) 3614 3615 diss_l = -ABS( u_comp_l ) * ( & 3616 ( 10.0_wp * ibit2_l * adv_sca_5 & 3617 + 3.0_wp * ibit1_l * adv_sca_3 & 3618 + ibit0_l * adv_sca_1 & 3619 ) * & 3620 ( sk(k,j,i) - sk(k,j,i-1) ) & 3621 - ( 5.0_wp * ibit2_l * adv_sca_5 & 3622 + ibit1_l * adv_sca_3 & 3623 ) * & 3624 ( sk(k,j,i+1) - sk(k,j,i-2) ) & 3625 + ( ibit2_l * adv_sca_5 & 3626 ) * & 3627 ( sk(k,j,i+2) - sk(k,j,i-3) ) & 3628 ) 3629 #else 3630 flux_l = swap_flux_x_local(k,j) 3631 diss_l = swap_diss_x_local(k,j) 3632 #endif 3633 3514 3634 ibit5 = REAL( IBITS(advc_flags_1(k,j,i),5,1), KIND = wp ) 3515 3635 ibit4 = REAL( IBITS(advc_flags_1(k,j,i),4,1), KIND = wp ) 3516 3636 ibit3 = REAL( IBITS(advc_flags_1(k,j,i),3,1), KIND = wp ) 3517 3637 3518 v_comp 3519 flux_n (k) = v_comp * (&3638 v_comp = v(k,j+1,i) - v_gtrans + v_stokes_zu(k) 3639 flux_n = v_comp * ( & 3520 3640 ( 37.0_wp * ibit5 * adv_sca_5 & 3521 3641 + 7.0_wp * ibit4 * adv_sca_3 & … … 3532 3652 ) 3533 3653 3534 diss_n (k) = -ABS( v_comp ) * (&3654 diss_n = -ABS( v_comp ) * ( & 3535 3655 ( 10.0_wp * ibit5 * adv_sca_5 & 3536 3656 + 3.0_wp * ibit4 * adv_sca_3 & … … 3546 3666 ( sk(k,j+3,i) - sk(k,j-2,i) ) & 3547 3667 ) 3668 3669 #ifdef _OPENACC 3670 ! 3671 !-- Recompute the south fluxes. 3672 ibit5_s = REAL( IBITS(advc_flags_1(k,j-1,i),5,1), KIND = wp ) 3673 ibit4_s = REAL( IBITS(advc_flags_1(k,j-1,i),4,1), KIND = wp ) 3674 ibit3_s = REAL( IBITS(advc_flags_1(k,j-1,i),3,1), KIND = wp ) 3675 3676 v_comp_s = v(k,j,i) - v_gtrans + v_stokes_zu(k) 3677 flux_s = v_comp_s * ( & 3678 ( 37.0_wp * ibit5_s * adv_sca_5 & 3679 + 7.0_wp * ibit4_s * adv_sca_3 & 3680 + ibit3_s * adv_sca_1 & 3681 ) * & 3682 ( sk(k,j,i) + sk(k,j-1,i) ) & 3683 - ( 8.0_wp * ibit5_s * adv_sca_5 & 3684 + ibit4_s * adv_sca_3 & 3685 ) * & 3686 ( sk(k,j+1,i) + sk(k,j-2,i) ) & 3687 + ( ibit5_s * adv_sca_5 & 3688 ) * & 3689 ( sk(k,j+2,i) + sk(k,j-3,i) ) & 3690 ) 3691 3692 diss_s = -ABS( v_comp_s ) * ( & 3693 ( 10.0_wp * ibit5_s * adv_sca_5 & 3694 + 3.0_wp * ibit4_s * adv_sca_3 & 3695 + ibit3_s * adv_sca_1 & 3696 ) * & 3697 ( sk(k,j,i) - sk(k,j-1,i) ) & 3698 - ( 5.0_wp * ibit5_s * adv_sca_5 & 3699 + ibit4_s * adv_sca_3 & 3700 ) * & 3701 ( sk(k,j+1,i) - sk(k,j-2,i) ) & 3702 + ( ibit5_s * adv_sca_5 & 3703 ) * & 3704 ( sk(k,j+2,i) - sk(k,j-3,i) ) & 3705 ) 3706 #else 3707 flux_s = swap_flux_y_local(k) 3708 diss_s = swap_diss_y_local(k) 3709 #endif 3710 3548 3711 ! 3549 3712 !-- k index has to be modified near bottom and top, else array … … 3558 3721 3559 3722 3560 flux_t (k) = w(k,j,i) * rho_air_zw(k) * (&3723 flux_t = w(k,j,i) * rho_air_zw(k) * ( & 3561 3724 ( 37.0_wp * ibit8 * adv_sca_5 & 3562 3725 + 7.0_wp * ibit7 * adv_sca_3 & … … 3572 3735 ) 3573 3736 3574 diss_t (k) = -ABS( w(k,j,i) ) * rho_air_zw(k) * (&3737 diss_t = -ABS( w(k,j,i) ) * rho_air_zw(k) * ( & 3575 3738 ( 10.0_wp * ibit8 * adv_sca_5 & 3576 3739 + 3.0_wp * ibit7 * adv_sca_3 & … … 3616 3779 3617 3780 tend(k,j,i) = tend(k,j,i) - ( & 3618 ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j) - & 3619 swap_diss_x_local(k,j) ) * ddx & 3620 + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k) - & 3621 swap_diss_y_local(k) ) * ddy & 3622 + ( ( flux_t(k) + diss_t(k) ) - & 3623 ( flux_d + diss_d ) & 3624 ) * drho_air(k) * ddzw(k) & 3781 ( ( flux_r + diss_r ) & 3782 - ( flux_l + diss_l ) ) * ddx & 3783 + ( ( flux_n + diss_n ) & 3784 - ( flux_s + diss_s ) ) * ddy & 3785 + ( ( flux_t + diss_t ) & 3786 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) & 3625 3787 ) + sk(k,j,i) * div 3626 3788 3627 swap_flux_y_local(k) = flux_n(k) 3628 swap_diss_y_local(k) = diss_n(k) 3629 swap_flux_x_local(k,j) = flux_r(k) 3630 swap_diss_x_local(k,j) = diss_r(k) 3631 flux_d = flux_t(k) 3632 diss_d = diss_t(k) 3789 #ifndef _OPENACC 3790 swap_flux_y_local(k) = flux_n 3791 swap_diss_y_local(k) = diss_n 3792 swap_flux_x_local(k,j) = flux_r 3793 swap_diss_x_local(k,j) = diss_r 3794 #endif 3795 flux_d = flux_t 3796 diss_d = diss_t 3797 3798 ! 3799 !-- Evaluation of statistics. 3800 SELECT CASE ( sk_num ) 3801 3802 CASE ( 1 ) 3803 !$ACC ATOMIC 3804 sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) & 3805 + ( flux_t & 3806 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3807 * ( w(k,j,i) - hom(k,1,3,0) ) & 3808 + diss_t & 3809 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3810 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3811 ) * weight_substep(intermediate_timestep_count) 3812 CASE ( 2 ) 3813 !$ACC ATOMIC 3814 sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) & 3815 + ( flux_t & 3816 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3817 * ( w(k,j,i) - hom(k,1,3,0) ) & 3818 + diss_t & 3819 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3820 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3821 ) * weight_substep(intermediate_timestep_count) 3822 CASE ( 3 ) 3823 !$ACC ATOMIC 3824 sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn) & 3825 + ( flux_t & 3826 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3827 * ( w(k,j,i) - hom(k,1,3,0) ) & 3828 + diss_t & 3829 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3830 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3831 ) * weight_substep(intermediate_timestep_count) 3832 CASE ( 4 ) 3833 !$ACC ATOMIC 3834 sums_wsqcs_ws_l(k,tn) = sums_wsqcs_ws_l(k,tn) & 3835 + ( flux_t & 3836 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3837 * ( w(k,j,i) - hom(k,1,3,0) ) & 3838 + diss_t & 3839 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3840 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3841 ) * weight_substep(intermediate_timestep_count) 3842 CASE ( 5 ) 3843 !$ACC ATOMIC 3844 sums_wsqrs_ws_l(k,tn) = sums_wsqrs_ws_l(k,tn) & 3845 + ( flux_t & 3846 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3847 * ( w(k,j,i) - hom(k,1,3,0) ) & 3848 + diss_t & 3849 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3850 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3851 ) * weight_substep(intermediate_timestep_count) 3852 CASE ( 6 ) 3853 !$ACC ATOMIC 3854 sums_wsncs_ws_l(k,tn) = sums_wsncs_ws_l(k,tn) & 3855 + ( flux_t & 3856 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3857 * ( w(k,j,i) - hom(k,1,3,0) ) & 3858 + diss_t & 3859 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3860 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3861 ) * weight_substep(intermediate_timestep_count) 3862 CASE ( 7 ) 3863 !$ACC ATOMIC 3864 sums_wsnrs_ws_l(k,tn) = sums_wsnrs_ws_l(k,tn) & 3865 + ( flux_t & 3866 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3867 * ( w(k,j,i) - hom(k,1,3,0) ) & 3868 + diss_t & 3869 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3870 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3871 ) * weight_substep(intermediate_timestep_count) 3872 CASE ( 8 ) 3873 !$ACC ATOMIC 3874 sums_wsss_ws_l(k,tn) = sums_wsss_ws_l(k,tn) & 3875 + ( flux_t & 3876 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3877 * ( w(k,j,i) - hom(k,1,3,0) ) & 3878 + diss_t & 3879 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3880 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3881 ) * weight_substep(intermediate_timestep_count) 3882 CASE ( 9 ) 3883 !$ACC ATOMIC 3884 sums_salsa_ws_l(k,tn) = sums_salsa_ws_l(k,tn) & 3885 + ( flux_t & 3886 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3887 * ( w(k,j,i) - hom(k,1,3,0) ) & 3888 + diss_t & 3889 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3890 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3891 ) * weight_substep(intermediate_timestep_count) 3892 3893 END SELECT 3633 3894 3634 3895 ENDDO … … 3636 3897 DO k = nzb_max+1, nzt 3637 3898 3638 u_comp 3639 flux_r (k) = u_comp * (&3899 u_comp = u(k,j,i+1) - u_gtrans + u_stokes_zu(k) 3900 flux_r = u_comp * ( & 3640 3901 37.0_wp * ( sk(k,j,i+1) + sk(k,j,i) ) & 3641 3902 - 8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) ) & 3642 3903 + ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5 3643 diss_r (k) = -ABS( u_comp ) * (&3904 diss_r = -ABS( u_comp ) * ( & 3644 3905 10.0_wp * ( sk(k,j,i+1) - sk(k,j,i) ) & 3645 3906 - 5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) ) & 3646 3907 + ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5 3647 3908 3648 v_comp = v(k,j+1,i) - v_gtrans + v_stokes_zu(k) 3649 flux_n(k) = v_comp * ( & 3909 #ifdef _OPENACC 3910 ! 3911 !-- Recompute the left fluxes. 3912 u_comp_l = u(k,j,i) - u_gtrans + u_stokes_zu(k) 3913 flux_l = u_comp_l * ( & 3914 37.0_wp * ( sk(k,j,i) + sk(k,j,i-1) ) & 3915 - 8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) & 3916 + ( sk(k,j,i+2) + sk(k,j,i-3) ) & 3917 ) * adv_sca_5 3918 3919 diss_l = -ABS( u_comp_l ) * ( & 3920 10.0_wp * ( sk(k,j,i) - sk(k,j,i-1) ) & 3921 - 5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) & 3922 + ( sk(k,j,i+2) - sk(k,j,i-3) ) & 3923 ) * adv_sca_5 3924 #else 3925 flux_l = swap_flux_x_local(k,j) 3926 diss_l = swap_diss_x_local(k,j) 3927 #endif 3928 3929 v_comp = v(k,j+1,i) - v_gtrans + v_stokes_zu(k) 3930 flux_n = v_comp * ( & 3650 3931 37.0_wp * ( sk(k,j+1,i) + sk(k,j,i) ) & 3651 3932 - 8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) ) & 3652 3933 + ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5 3653 diss_n (k) = -ABS( v_comp ) * (&3934 diss_n = -ABS( v_comp ) * ( & 3654 3935 10.0_wp * ( sk(k,j+1,i) - sk(k,j,i) ) & 3655 3936 - 5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) ) & 3656 3937 + ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5 3938 3939 #ifdef _OPENACC 3940 ! 3941 !-- Recompute the south fluxes. 3942 v_comp_s = v(k,j,i) - v_gtrans + v_stokes_zu(k) 3943 flux_s = v_comp_s * ( & 3944 37.0_wp * ( sk(k,j,i) + sk(k,j-1,i) ) & 3945 - 8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) ) & 3946 + ( sk(k,j+2,i) + sk(k,j-3,i) ) & 3947 ) * adv_sca_5 3948 diss_s = -ABS( v_comp_s ) * ( & 3949 10.0_wp * ( sk(k,j,i) - sk(k,j-1,i) ) & 3950 - 5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) ) & 3951 + sk(k,j+2,i) - sk(k,j-3,i) & 3952 ) * adv_sca_5 3953 #else 3954 flux_s = swap_flux_y_local(k) 3955 diss_s = swap_diss_y_local(k) 3956 #endif 3957 3657 3958 ! 3658 3959 !-- k index has to be modified near bottom and top, else array … … 3667 3968 3668 3969 3669 flux_t (k)= w(k,j,i) * rho_air_zw(k) * ( &3970 flux_t = w(k,j,i) * rho_air_zw(k) * ( & 3670 3971 ( 37.0_wp * ibit8 * adv_sca_5 & 3671 3972 + 7.0_wp * ibit7 * adv_sca_3 & … … 3681 3982 ) 3682 3983 3683 diss_t (k)= -ABS( w(k,j,i) ) * rho_air_zw(k) * ( &3984 diss_t = -ABS( w(k,j,i) ) * rho_air_zw(k) * ( & 3684 3985 ( 10.0_wp * ibit8 * adv_sca_5 & 3685 3986 + 3.0_wp * ibit7 * adv_sca_3 & … … 3706 4007 3707 4008 tend(k,j,i) = tend(k,j,i) - ( & 3708 ( flux_r(k) + diss_r(k) - swap_flux_x_local(k,j) - & 3709 swap_diss_x_local(k,j) ) * ddx & 3710 + ( flux_n(k) + diss_n(k) - swap_flux_y_local(k) - & 3711 swap_diss_y_local(k) ) * ddy & 3712 + ( ( flux_t(k) + diss_t(k) ) - & 3713 ( flux_d + diss_d ) & 3714 ) * drho_air(k) * ddzw(k) & 4009 ( ( flux_r + diss_r ) & 4010 - ( flux_l + diss_l ) ) * ddx & 4011 + ( ( flux_n + diss_n ) & 4012 - ( flux_s + diss_s ) ) * ddy & 4013 + ( ( flux_t + diss_t ) & 4014 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) & 3715 4015 ) + sk(k,j,i) * div 3716 4016 3717 swap_flux_y_local(k) = flux_n(k) 3718 swap_diss_y_local(k) = diss_n(k) 3719 swap_flux_x_local(k,j) = flux_r(k) 3720 swap_diss_x_local(k,j) = diss_r(k) 3721 flux_d = flux_t(k) 3722 diss_d = diss_t(k) 3723 3724 ENDDO 3725 ! 3726 !-- Evaluation of statistics. 3727 SELECT CASE ( sk_char ) 3728 3729 CASE ( 'pt' ) 3730 DO k = nzb, nzt 4017 #ifndef _OPENACC 4018 swap_flux_y_local(k) = flux_n 4019 swap_diss_y_local(k) = diss_n 4020 swap_flux_x_local(k,j) = flux_r 4021 swap_diss_x_local(k,j) = diss_r 4022 #endif 4023 flux_d = flux_t 4024 diss_d = diss_t 4025 4026 ! 4027 !-- Evaluation of statistics. 4028 SELECT CASE ( sk_num ) 4029 4030 CASE ( 1 ) 4031 !$ACC ATOMIC 3731 4032 sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) & 3732 + ( flux_t (k)&4033 + ( flux_t & 3733 4034 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3734 4035 * ( w(k,j,i) - hom(k,1,3,0) ) & 3735 + diss_t (k)&4036 + diss_t & 3736 4037 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3737 4038 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3738 4039 ) * weight_substep(intermediate_timestep_count) 3739 ENDDO 3740 CASE ( 'sa' ) 3741 DO k = nzb, nzt 4040 CASE ( 2 ) 4041 !$ACC ATOMIC 3742 4042 sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) & 3743 + ( flux_t (k)&4043 + ( flux_t & 3744 4044 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3745 4045 * ( w(k,j,i) - hom(k,1,3,0) ) & 3746 + diss_t (k)&4046 + diss_t & 3747 4047 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3748 4048 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3749 4049 ) * weight_substep(intermediate_timestep_count) 3750 ENDDO 3751 CASE ( 'q' ) 3752 DO k = nzb, nzt 4050 CASE ( 3 ) 4051 !$ACC ATOMIC 3753 4052 sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn) & 3754 + ( flux_t (k)&4053 + ( flux_t & 3755 4054 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3756 4055 * ( w(k,j,i) - hom(k,1,3,0) ) & 3757 + diss_t (k)&4056 + diss_t & 3758 4057 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3759 4058 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3760 4059 ) * weight_substep(intermediate_timestep_count) 3761 ENDDO 3762 CASE ( 'qc' ) 3763 DO k = nzb, nzt 4060 CASE ( 4 ) 4061 !$ACC ATOMIC 3764 4062 sums_wsqcs_ws_l(k,tn) = sums_wsqcs_ws_l(k,tn) & 3765 + ( flux_t (k)&4063 + ( flux_t & 3766 4064 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3767 4065 * ( w(k,j,i) - hom(k,1,3,0) ) & 3768 + diss_t (k)&4066 + diss_t & 3769 4067 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3770 4068 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3771 4069 ) * weight_substep(intermediate_timestep_count) 3772 ENDDO 3773 CASE ( 'qr' ) 3774 DO k = nzb, nzt 4070 CASE ( 5 ) 4071 !$ACC ATOMIC 3775 4072 sums_wsqrs_ws_l(k,tn) = sums_wsqrs_ws_l(k,tn) & 3776 + ( flux_t (k)&4073 + ( flux_t & 3777 4074 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3778 4075 * ( w(k,j,i) - hom(k,1,3,0) ) & 3779 + diss_t (k)&4076 + diss_t & 3780 4077 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3781 4078 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3782 4079 ) * weight_substep(intermediate_timestep_count) 3783 ENDDO 3784 CASE ( 'nc' ) 3785 DO k = nzb, nzt 4080 CASE ( 6 ) 4081 !$ACC ATOMIC 3786 4082 sums_wsncs_ws_l(k,tn) = sums_wsncs_ws_l(k,tn) & 3787 + ( flux_t (k)&4083 + ( flux_t & 3788 4084 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3789 4085 * ( w(k,j,i) - hom(k,1,3,0) ) & 3790 + diss_t (k)&4086 + diss_t & 3791 4087 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3792 4088 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3793 4089 ) * weight_substep(intermediate_timestep_count) 3794 ENDDO 3795 CASE ( 'nr' ) 3796 DO k = nzb, nzt 4090 CASE ( 7 ) 4091 !$ACC ATOMIC 3797 4092 sums_wsnrs_ws_l(k,tn) = sums_wsnrs_ws_l(k,tn) & 3798 + ( flux_t (k)&4093 + ( flux_t & 3799 4094 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3800 4095 * ( w(k,j,i) - hom(k,1,3,0) ) & 3801 + diss_t (k)&4096 + diss_t & 3802 4097 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3803 4098 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3804 4099 ) * weight_substep(intermediate_timestep_count) 3805 ENDDO 3806 CASE ( 's' ) 3807 DO k = nzb, nzt 4100 CASE ( 8 ) 4101 !$ACC ATOMIC 3808 4102 sums_wsss_ws_l(k,tn) = sums_wsss_ws_l(k,tn) & 3809 + ( flux_t (k)&4103 + ( flux_t & 3810 4104 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3811 4105 * ( w(k,j,i) - hom(k,1,3,0) ) & 3812 + diss_t (k)&4106 + diss_t & 3813 4107 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3814 4108 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3815 4109 ) * weight_substep(intermediate_timestep_count) 3816 ENDDO 3817 3818 CASE ( 'aerosol_mass', 'aerosol_number', 'salsa_gas' ) 3819 DO k = nzb, nzt 4110 CASE ( 9 ) 4111 !$ACC ATOMIC 3820 4112 sums_salsa_ws_l(k,tn) = sums_salsa_ws_l(k,tn) & 3821 + ( flux_t (k)&4113 + ( flux_t & 3822 4114 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 3823 4115 * ( w(k,j,i) - hom(k,1,3,0) ) & 3824 + diss_t (k)&4116 + diss_t & 3825 4117 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 3826 4118 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 3827 4119 ) * weight_substep(intermediate_timestep_count) 3828 ENDDO 3829 3830 3831 END SELECT4120 4121 END SELECT 4122 4123 ENDDO 3832 4124 3833 4125 ENDDO … … 3874 4166 REAL(wp) :: ibit10 !< flag indicating 3rd-order scheme along x-direction 3875 4167 REAL(wp) :: ibit11 !< flag indicating 5th-order scheme along x-direction 4168 #ifdef _OPENACC 4169 REAL(wp) :: ibit9_l !< flag indicating 1st-order scheme along x-direction 4170 REAL(wp) :: ibit10_l !< flag indicating 3rd-order scheme along x-direction 4171 REAL(wp) :: ibit11_l !< flag indicating 5th-order scheme along x-direction 4172 #endif 3876 4173 REAL(wp) :: ibit12 !< flag indicating 1st-order scheme along y-direction 3877 4174 REAL(wp) :: ibit13 !< flag indicating 3rd-order scheme along y-direction 3878 4175 REAL(wp) :: ibit14 !< flag indicating 5th-order scheme along y-direction 4176 #ifdef _OPENACC 4177 REAL(wp) :: ibit12_s !< flag indicating 1st-order scheme along y-direction 4178 REAL(wp) :: ibit13_s !< flag indicating 3rd-order scheme along y-direction 4179 REAL(wp) :: ibit14_s !< flag indicating 5th-order scheme along y-direction 4180 #endif 3879 4181 REAL(wp) :: ibit15 !< flag indicating 1st-order scheme along z-direction 3880 4182 REAL(wp) :: ibit16 !< flag indicating 3rd-order scheme along z-direction … … 3886 4188 REAL(wp) :: gv !< Galilei-transformation velocity along y 3887 4189 REAL(wp) :: v_comp !< advection velocity along y 4190 #ifdef _OPENACC 4191 REAL(wp) :: v_comp_s !< advection velocity along y 4192 #endif 3888 4193 REAL(wp) :: w_comp !< advection velocity along z 3889 4194 4195 REAL(wp) :: diss_s !< discretized artificial dissipation at southward-side of the grid box 4196 REAL(wp) :: flux_s !< discretized 6th-order flux at southward-side of the grid box 4197 #ifndef _OPENACC 3890 4198 REAL(wp), DIMENSION(nzb+1:nzt) :: swap_diss_y_local_u !< discretized artificial dissipation at southward-side of the grid box 3891 4199 REAL(wp), DIMENSION(nzb+1:nzt) :: swap_flux_y_local_u !< discretized 6th-order flux at southward-side of the grid box 4200 #endif 3892 4201 4202 REAL(wp) :: diss_l !< discretized artificial dissipation at leftward-side of the grid box 4203 REAL(wp) :: flux_l !< discretized 6th-order flux at leftward-side of the grid box 4204 #ifndef _OPENACC 3893 4205 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_u !< discretized artificial dissipation at leftward-side of the grid box 3894 4206 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_flux_x_local_u !< discretized 6th-order flux at leftward-side of the grid box 4207 #endif 3895 4208 3896 REAL(wp), DIMENSION(nzb:nzt) :: diss_n !< discretized artificial dissipation at northward-side of the grid box 3897 REAL(wp), DIMENSION(nzb:nzt) :: diss_r !< discretized artificial dissipation at leftward-side of the grid box 3898 REAL(wp), DIMENSION(nzb:nzt) :: diss_t !< discretized artificial dissipation at top of the grid box 3899 REAL(wp), DIMENSION(nzb:nzt) :: flux_n !< discretized 6th-order flux at northward-side of the grid box 3900 REAL(wp), DIMENSION(nzb:nzt) :: flux_r !< discretized 6th-order flux at rightward-side of the grid box 3901 REAL(wp), DIMENSION(nzb:nzt) :: flux_t !< discretized 6th-order flux at top of the grid box 3902 REAL(wp), DIMENSION(nzb:nzt) :: u_comp !< advection velocity along x 4209 REAL(wp) :: diss_n !< discretized artificial dissipation at northward-side of the grid box 4210 REAL(wp) :: diss_r !< discretized artificial dissipation at leftward-side of the grid box 4211 REAL(wp) :: diss_t !< discretized artificial dissipation at top of the grid box 4212 REAL(wp) :: flux_n !< discretized 6th-order flux at northward-side of the grid box 4213 REAL(wp) :: flux_r !< discretized 6th-order flux at rightward-side of the grid box 4214 REAL(wp) :: flux_t !< discretized 6th-order flux at top of the grid box 4215 REAL(wp) :: u_comp !< advection velocity along x 4216 #ifdef _OPENACC 4217 REAL(wp) :: u_comp_l !< 4218 #endif 3903 4219 3904 4220 gu = 2.0_wp * u_gtrans 3905 4221 gv = 2.0_wp * v_gtrans 3906 4222 4223 #ifndef _OPENACC 3907 4224 ! 3908 4225 !-- Compute the fluxes for the whole left boundary of the processor domain. … … 3915 4232 ibit9 = REAL( IBITS(advc_flags_1(k,j,i-1),9,1), KIND = wp ) 3916 4233 3917 u_comp (k)= u(k,j,i) + u(k,j,i-1) - gu3918 swap_flux_x_local_u(k,j) = u_comp (k) * (&4234 u_comp = u(k,j,i) + u(k,j,i-1) - gu 4235 swap_flux_x_local_u(k,j) = u_comp * ( & 3919 4236 ( 37.0_wp * ibit11 * adv_mom_5 & 3920 4237 + 7.0_wp * ibit10 * adv_mom_3 & … … 3931 4248 ) 3932 4249 3933 swap_diss_x_local_u(k,j) = - ABS( u_comp (k) ) * (&4250 swap_diss_x_local_u(k,j) = - ABS( u_comp ) * ( & 3934 4251 ( 10.0_wp * ibit11 * adv_mom_5 & 3935 4252 + 3.0_wp * ibit10 * adv_mom_3 & … … 3950 4267 DO k = nzb_max+1, nzt 3951 4268 3952 u_comp (k)= u(k,j,i) + u(k,j,i-1) - gu3953 swap_flux_x_local_u(k,j) = u_comp (k) * (&4269 u_comp = u(k,j,i) + u(k,j,i-1) - gu 4270 swap_flux_x_local_u(k,j) = u_comp * ( & 3954 4271 37.0_wp * ( u(k,j,i) + u(k,j,i-1) ) & 3955 4272 - 8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) ) & 3956 4273 + ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5 3957 swap_diss_x_local_u(k,j) = - ABS(u_comp (k)) * (&4274 swap_diss_x_local_u(k,j) = - ABS(u_comp) * ( & 3958 4275 10.0_wp * ( u(k,j,i) - u(k,j,i-1) ) & 3959 4276 - 5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) ) & … … 3962 4279 ENDDO 3963 4280 ENDDO 3964 4281 #endif 4282 4283 !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) & 4284 !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) & 4285 !$ACC PRIVATE(ibit9, ibit10, ibit11, ibit12, ibit13, ibit14) & 4286 !$ACC PRIVATE(ibit9_l, ibit10_l, ibit11_l) & 4287 !$ACC PRIVATE(ibit12_s, ibit13_s, ibit14_s) & 4288 !$ACC PRIVATE(ibit15, ibit16, ibit17) & 4289 !$ACC PRIVATE(flux_r, diss_r, flux_l, diss_l) & 4290 !$ACC PRIVATE(flux_n, diss_n, flux_s, diss_s) & 4291 !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) & 4292 !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) & 4293 !$ACC PRESENT(advc_flags_1) & 4294 !$ACC PRESENT(u, v, w) & 4295 !$ACC PRESENT(drho_air, rho_air_zw, ddzw) & 4296 !$ACC PRESENT(tend) & 4297 !$ACC PRESENT(hom(nzb+1:nzb_max,1,1:3,0)) & 4298 !$ACC PRESENT(weight_substep(intermediate_timestep_count)) & 4299 !$ACC PRESENT(sums_us2_ws_l, sums_wsus_ws_l) 3965 4300 DO i = nxlu, nxr 4301 #ifndef _OPENACC 3966 4302 ! 3967 4303 !-- The following loop computes the fluxes for the south boundary points … … 4019 4355 4020 4356 ENDDO 4357 #endif 4358 4021 4359 ! 4022 4360 !-- Computation of interior fluxes and tendency terms 4023 4361 DO j = nys, nyn 4024 4362 4025 flux_t(0) = 0.0_wp4026 diss_t(0) = 0.0_wp4027 4363 flux_d = 0.0_wp 4028 4364 diss_d = 0.0_wp … … 4034 4370 ibit9 = REAL( IBITS(advc_flags_1(k,j,i),9,1), KIND = wp ) 4035 4371 4036 u_comp (k)= u(k,j,i+1) + u(k,j,i)4037 flux_r (k) = ( u_comp(k) - gu ) * (&4372 u_comp = u(k,j,i+1) + u(k,j,i) 4373 flux_r = ( u_comp - gu ) * ( & 4038 4374 ( 37.0_wp * ibit11 * adv_mom_5 & 4039 4375 + 7.0_wp * ibit10 * adv_mom_3 & … … 4050 4386 ) 4051 4387 4052 diss_r (k) = - ABS( u_comp(k) - gu ) * (&4388 diss_r = - ABS( u_comp - gu ) * ( & 4053 4389 ( 10.0_wp * ibit11 * adv_mom_5 & 4054 4390 + 3.0_wp * ibit10 * adv_mom_3 & … … 4065 4401 ) 4066 4402 4403 #ifdef _OPENACC 4404 ! 4405 !-- Recompute the left fluxes. 4406 ibit11_l = REAL( IBITS(advc_flags_1(k,j,i-1),11,1), KIND = wp ) 4407 ibit10_l = REAL( IBITS(advc_flags_1(k,j,i-1),10,1), KIND = wp ) 4408 ibit9_l = REAL( IBITS(advc_flags_1(k,j,i-1),9,1), KIND = wp ) 4409 4410 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu 4411 flux_l = u_comp_l * ( & 4412 ( 37.0_wp * ibit11_l * adv_mom_5 & 4413 + 7.0_wp * ibit10_l * adv_mom_3 & 4414 + ibit9_l * adv_mom_1 & 4415 ) * & 4416 ( u(k,j,i) + u(k,j,i-1) ) & 4417 - ( 8.0_wp * ibit11_l * adv_mom_5 & 4418 + ibit10_l * adv_mom_3 & 4419 ) * & 4420 ( u(k,j,i+1) + u(k,j,i-2) ) & 4421 + ( ibit11_l * adv_mom_5 & 4422 ) * & 4423 ( u(k,j,i+2) + u(k,j,i-3) ) & 4424 ) 4425 4426 diss_l = - ABS( u_comp_l ) * ( & 4427 ( 10.0_wp * ibit11_l * adv_mom_5 & 4428 + 3.0_wp * ibit10_l * adv_mom_3 & 4429 + ibit9_l * adv_mom_1 & 4430 ) * & 4431 ( u(k,j,i) - u(k,j,i-1) ) & 4432 - ( 5.0_wp * ibit11_l * adv_mom_5 & 4433 + ibit10_l * adv_mom_3 & 4434 ) * & 4435 ( u(k,j,i+1) - u(k,j,i-2) ) & 4436 + ( ibit11_l * adv_mom_5 & 4437 ) * & 4438 ( u(k,j,i+2) - u(k,j,i-3) ) & 4439 ) 4440 #else 4441 flux_l = swap_flux_x_local_u(k,j) 4442 diss_l = swap_diss_x_local_u(k,j) 4443 #endif 4444 4067 4445 ibit14 = REAL( IBITS(advc_flags_1(k,j,i),14,1), KIND = wp ) 4068 4446 ibit13 = REAL( IBITS(advc_flags_1(k,j,i),13,1), KIND = wp ) 4069 4447 ibit12 = REAL( IBITS(advc_flags_1(k,j,i),12,1), KIND = wp ) 4070 4448 4071 v_comp 4072 flux_n (k) = v_comp * (&4449 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 4450 flux_n = v_comp * ( & 4073 4451 ( 37.0_wp * ibit14 * adv_mom_5 & 4074 4452 + 7.0_wp * ibit13 * adv_mom_3 & … … 4085 4463 ) 4086 4464 4087 diss_n (k) = - ABS ( v_comp ) * (&4465 diss_n = - ABS ( v_comp ) * ( & 4088 4466 ( 10.0_wp * ibit14 * adv_mom_5 & 4089 4467 + 3.0_wp * ibit13 * adv_mom_3 & … … 4099 4477 ( u(k,j+3,i) - u(k,j-2,i) ) & 4100 4478 ) 4479 4480 #ifdef _OPENACC 4481 ! 4482 !-- Recompute the south fluxes. 4483 ibit14_s = REAL( IBITS(advc_flags_1(k,j-1,i),14,1), KIND = wp ) 4484 ibit13_s = REAL( IBITS(advc_flags_1(k,j-1,i),13,1), KIND = wp ) 4485 ibit12_s = REAL( IBITS(advc_flags_1(k,j-1,i),12,1), KIND = wp ) 4486 4487 v_comp_s = v(k,j,i) + v(k,j,i-1) - gv 4488 flux_s = v_comp_s * ( & 4489 ( 37.0_wp * ibit14_s * adv_mom_5 & 4490 + 7.0_wp * ibit13_s * adv_mom_3 & 4491 + ibit12_s * adv_mom_1 & 4492 ) * & 4493 ( u(k,j,i) + u(k,j-1,i) ) & 4494 - ( 8.0_wp * ibit14_s * adv_mom_5 & 4495 + ibit13_s * adv_mom_3 & 4496 ) * & 4497 ( u(k,j+1,i) + u(k,j-2,i) ) & 4498 + ( ibit14_s * adv_mom_5 & 4499 ) * & 4500 ( u(k,j+2,i) + u(k,j-3,i) ) & 4501 ) 4502 4503 diss_s = - ABS ( v_comp_s ) * ( & 4504 ( 10.0_wp * ibit14_s * adv_mom_5 & 4505 + 3.0_wp * ibit13_s * adv_mom_3 & 4506 + ibit12_s * adv_mom_1 & 4507 ) * & 4508 ( u(k,j,i) - u(k,j-1,i) ) & 4509 - ( 5.0_wp * ibit14_s * adv_mom_5 & 4510 + ibit13_s * adv_mom_3 & 4511 ) * & 4512 ( u(k,j+1,i) - u(k,j-2,i) ) & 4513 + ( ibit14_s * adv_mom_5 & 4514 ) * & 4515 ( u(k,j+2,i) - u(k,j-3,i) ) & 4516 ) 4517 #else 4518 flux_s = swap_flux_y_local_u(k) 4519 diss_s = swap_diss_y_local_u(k) 4520 #endif 4521 4101 4522 ! 4102 4523 !-- k index has to be modified near bottom and top, else array … … 4110 4531 k_mm = k - 2 * ibit17 4111 4532 4112 w_comp 4113 flux_t (k) = w_comp * rho_air_zw(k) * (&4533 w_comp = w(k,j,i) + w(k,j,i-1) 4534 flux_t = w_comp * rho_air_zw(k) * ( & 4114 4535 ( 37.0_wp * ibit17 * adv_mom_5 & 4115 4536 + 7.0_wp * ibit16 * adv_mom_3 & … … 4126 4547 ) 4127 4548 4128 diss_t (k) = - ABS( w_comp ) * rho_air_zw(k) * (&4549 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( & 4129 4550 ( 10.0_wp * ibit17 * adv_mom_5 & 4130 4551 + 3.0_wp * ibit16 * adv_mom_3 & … … 4144 4565 !-- correction is needed to overcome numerical instabilities caused 4145 4566 !-- by a not sufficient reduction of divergences near topography. 4146 div = ( ( u_comp (k) * ( ibit9 + ibit10 + ibit11 )&4567 div = ( ( u_comp * ( ibit9 + ibit10 + ibit11 ) & 4147 4568 - ( u(k,j,i) + u(k,j,i-1) ) & 4148 4569 * ( & … … 4173 4594 4174 4595 tend(k,j,i) = tend(k,j,i) - ( & 4175 ( flux_r(k) + diss_r(k) & 4176 - swap_flux_x_local_u(k,j) - swap_diss_x_local_u(k,j) ) * ddx & 4177 + ( flux_n(k) + diss_n(k) & 4178 - swap_flux_y_local_u(k) - swap_diss_y_local_u(k) ) * ddy & 4179 + ( ( flux_t(k) + diss_t(k) ) & 4180 - ( flux_d + diss_d ) & 4181 ) * drho_air(k) * ddzw(k) & 4596 ( ( flux_r + diss_r ) & 4597 - ( flux_l + diss_l ) ) * ddx & 4598 + ( ( flux_n + diss_n ) & 4599 - ( flux_s + diss_s ) ) * ddy & 4600 + ( ( flux_t + diss_t ) & 4601 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) & 4182 4602 ) + div * u(k,j,i) 4183 4603 4184 swap_flux_x_local_u(k,j) = flux_r(k) 4185 swap_diss_x_local_u(k,j) = diss_r(k) 4186 swap_flux_y_local_u(k) = flux_n(k) 4187 swap_diss_y_local_u(k) = diss_n(k) 4188 flux_d = flux_t(k) 4189 diss_d = diss_t(k) 4604 #ifndef _OPENACC 4605 swap_flux_x_local_u(k,j) = flux_r 4606 swap_diss_x_local_u(k,j) = diss_r 4607 swap_flux_y_local_u(k) = flux_n 4608 swap_diss_y_local_u(k) = diss_n 4609 #endif 4610 flux_d = flux_t 4611 diss_d = diss_t 4190 4612 ! 4191 4613 !-- Statistical Evaluation of u'u'. The factor has to be applied 4192 4614 !-- for right evaluation when gallilei_trans = .T. . 4615 !$ACC ATOMIC 4193 4616 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 4194 + ( flux_r (k)&4195 * ( u_comp (k) - 2.0_wp * hom(k,1,1,0) )&4196 / ( u_comp (k) - gu + SIGN( 1.0E-20_wp, u_comp(k) - gu ) )&4197 + diss_r (k)&4198 * ABS( u_comp (k) - 2.0_wp * hom(k,1,1,0) )&4199 / ( ABS( u_comp (k) - gu ) + 1.0E-20_wp )&4617 + ( flux_r & 4618 * ( u_comp - 2.0_wp * hom(k,1,1,0) ) & 4619 / ( u_comp - gu + SIGN( 1.0E-20_wp, u_comp - gu ) ) & 4620 + diss_r & 4621 * ABS( u_comp - 2.0_wp * hom(k,1,1,0) ) & 4622 / ( ABS( u_comp - gu ) + 1.0E-20_wp ) & 4200 4623 ) * weight_substep(intermediate_timestep_count) 4201 4624 ! 4202 4625 !-- Statistical Evaluation of w'u'. 4626 !$ACC ATOMIC 4203 4627 sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn) & 4204 + ( flux_t (k)&4628 + ( flux_t & 4205 4629 * ( w_comp - 2.0_wp * hom(k,1,3,0) ) & 4206 4630 / ( w_comp + SIGN( 1.0E-20_wp, w_comp ) ) & 4207 + diss_t (k)&4631 + diss_t & 4208 4632 * ABS( w_comp - 2.0_wp * hom(k,1,3,0) ) & 4209 4633 / ( ABS( w_comp ) + 1.0E-20_wp ) & … … 4214 4638 DO k = nzb_max+1, nzt 4215 4639 4216 u_comp (k)= u(k,j,i+1) + u(k,j,i)4217 flux_r (k) = ( u_comp(k) - gu ) * (&4640 u_comp = u(k,j,i+1) + u(k,j,i) 4641 flux_r = ( u_comp - gu ) * ( & 4218 4642 37.0_wp * ( u(k,j,i+1) + u(k,j,i) ) & 4219 4643 - 8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) ) & 4220 4644 + ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5 4221 diss_r (k) = - ABS( u_comp(k) - gu ) * (&4645 diss_r = - ABS( u_comp - gu ) * ( & 4222 4646 10.0_wp * ( u(k,j,i+1) - u(k,j,i) ) & 4223 4647 - 5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) ) & 4224 4648 + ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5 4225 4649 4226 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 4227 flux_n(k) = v_comp * ( & 4650 #ifdef _OPENACC 4651 ! 4652 !-- Recompute the left fluxes. 4653 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu 4654 flux_l = u_comp_l * ( & 4655 37.0_wp * ( u(k,j,i) + u(k,j,i-1) ) & 4656 - 8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) ) & 4657 + ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5 4658 diss_l = - ABS(u_comp_l) * ( & 4659 10.0_wp * ( u(k,j,i) - u(k,j,i-1) ) & 4660 - 5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) ) & 4661 + ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5 4662 #else 4663 flux_l = swap_flux_x_local_u(k,j) 4664 diss_l = swap_diss_x_local_u(k,j) 4665 #endif 4666 4667 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 4668 flux_n = v_comp * ( & 4228 4669 37.0_wp * ( u(k,j+1,i) + u(k,j,i) ) & 4229 4670 - 8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) ) & 4230 4671 + ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5 4231 diss_n (k) = - ABS( v_comp ) * (&4672 diss_n = - ABS( v_comp ) * ( & 4232 4673 10.0_wp * ( u(k,j+1,i) - u(k,j,i) ) & 4233 4674 - 5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) ) & 4234 4675 + ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5 4676 4677 #ifdef _OPENACC 4678 ! 4679 !-- Recompute the south fluxes. 4680 v_comp_s = v(k,j,i) + v(k,j,i-1) - gv 4681 flux_s = v_comp_s * ( & 4682 37.0_wp * ( u(k,j,i) + u(k,j-1,i) ) & 4683 - 8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) ) & 4684 + ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5 4685 diss_s = - ABS( v_comp_s ) * ( & 4686 10.0_wp * ( u(k,j,i) - u(k,j-1,i) ) & 4687 - 5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) ) & 4688 + ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5 4689 #else 4690 flux_s = swap_flux_y_local_u(k) 4691 diss_s = swap_diss_y_local_u(k) 4692 #endif 4693 4235 4694 ! 4236 4695 !-- k index has to be modified near bottom and top, else array … … 4244 4703 k_mm = k - 2 * ibit17 4245 4704 4246 w_comp 4247 flux_t (k) = w_comp * rho_air_zw(k) * (&4705 w_comp = w(k,j,i) + w(k,j,i-1) 4706 flux_t = w_comp * rho_air_zw(k) * ( & 4248 4707 ( 37.0_wp * ibit17 * adv_mom_5 & 4249 4708 + 7.0_wp * ibit16 * adv_mom_3 & … … 4260 4719 ) 4261 4720 4262 diss_t (k) = - ABS( w_comp ) * rho_air_zw(k) * (&4721 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( & 4263 4722 ( 10.0_wp * ibit17 * adv_mom_5 & 4264 4723 + 3.0_wp * ibit16 * adv_mom_3 & … … 4278 4737 !-- correction is needed to overcome numerical instabilities caused 4279 4738 !-- by a not sufficient reduction of divergences near topography. 4280 div = ( ( u_comp (k)- ( u(k,j,i) + u(k,j,i-1) ) ) * ddx &4739 div = ( ( u_comp - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx & 4281 4740 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy & 4282 4741 + ( w_comp * rho_air_zw(k) - & … … 4286 4745 4287 4746 tend(k,j,i) = tend(k,j,i) - ( & 4288 ( flux_r(k) + diss_r(k) & 4289 - swap_flux_x_local_u(k,j) - swap_diss_x_local_u(k,j) ) * ddx & 4290 + ( flux_n(k) + diss_n(k) & 4291 - swap_flux_y_local_u(k) - swap_diss_y_local_u(k) ) * ddy & 4292 + ( ( flux_t(k) + diss_t(k) ) & 4293 - ( flux_d + diss_d ) & 4294 ) * drho_air(k) * ddzw(k) & 4747 ( ( flux_r + diss_r ) & 4748 - ( flux_l + diss_l ) ) * ddx & 4749 + ( ( flux_n + diss_n ) & 4750 - ( flux_s + diss_s ) ) * ddy & 4751 + ( ( flux_t + diss_t ) & 4752 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) & 4295 4753 ) + div * u(k,j,i) 4296 4754 4297 swap_flux_x_local_u(k,j) = flux_r(k) 4298 swap_diss_x_local_u(k,j) = diss_r(k) 4299 swap_flux_y_local_u(k) = flux_n(k) 4300 swap_diss_y_local_u(k) = diss_n(k) 4301 flux_d = flux_t(k) 4302 diss_d = diss_t(k) 4755 #ifndef _OPENACC 4756 swap_flux_x_local_u(k,j) = flux_r 4757 swap_diss_x_local_u(k,j) = diss_r 4758 swap_flux_y_local_u(k) = flux_n 4759 swap_diss_y_local_u(k) = diss_n 4760 #endif 4761 flux_d = flux_t 4762 diss_d = diss_t 4303 4763 ! 4304 4764 !-- Statistical Evaluation of u'u'. The factor has to be applied 4305 4765 !-- for right evaluation when gallilei_trans = .T. . 4766 !$ACC ATOMIC 4306 4767 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 4307 + ( flux_r (k)&4308 * ( u_comp (k) - 2.0_wp * hom(k,1,1,0) )&4309 / ( u_comp (k) - gu + SIGN( 1.0E-20_wp, u_comp(k) - gu ) )&4310 + diss_r (k)&4311 * ABS( u_comp (k) - 2.0_wp * hom(k,1,1,0) )&4312 / ( ABS( u_comp (k) - gu ) + 1.0E-20_wp )&4768 + ( flux_r & 4769 * ( u_comp - 2.0_wp * hom(k,1,1,0) ) & 4770 / ( u_comp - gu + SIGN( 1.0E-20_wp, u_comp - gu ) ) & 4771 + diss_r & 4772 * ABS( u_comp - 2.0_wp * hom(k,1,1,0) ) & 4773 / ( ABS( u_comp - gu ) + 1.0E-20_wp ) & 4313 4774 ) * weight_substep(intermediate_timestep_count) 4314 4775 ! 4315 4776 !-- Statistical Evaluation of w'u'. 4777 !$ACC ATOMIC 4316 4778 sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn) & 4317 + ( flux_t (k)&4779 + ( flux_t & 4318 4780 * ( w_comp - 2.0_wp * hom(k,1,3,0) ) & 4319 4781 / ( w_comp + SIGN( 1.0E-20_wp, w_comp ) ) & 4320 + diss_t (k)&4782 + diss_t & 4321 4783 * ABS( w_comp - 2.0_wp * hom(k,1,3,0) ) & 4322 4784 / ( ABS( w_comp ) + 1.0E-20_wp ) & … … 4369 4831 REAL(wp) :: ibit19 !< flag indicating 3rd-order scheme along x-direction 4370 4832 REAL(wp) :: ibit20 !< flag indicating 5th-order scheme along x-direction 4833 #ifdef _OPENACC 4834 REAL(wp) :: ibit18_l !< flag indicating 1st-order scheme along x-direction 4835 REAL(wp) :: ibit19_l !< flag indicating 3rd-order scheme along x-direction 4836 REAL(wp) :: ibit20_l !< flag indicating 5th-order scheme along x-direction 4837 #endif 4371 4838 REAL(wp) :: ibit21 !< flag indicating 1st-order scheme along y-direction 4372 4839 REAL(wp) :: ibit22 !< flag indicating 3rd-order scheme along y-direction 4373 4840 REAL(wp) :: ibit23 !< flag indicating 5th-order scheme along y-direction 4841 #ifdef _OPENACC 4842 REAL(wp) :: ibit21_s !< flag indicating 1st-order scheme along y-direction 4843 REAL(wp) :: ibit22_s !< flag indicating 3rd-order scheme along y-direction 4844 REAL(wp) :: ibit23_s !< flag indicating 5th-order scheme along y-direction 4845 #endif 4374 4846 REAL(wp) :: ibit24 !< flag indicating 1st-order scheme along z-direction 4375 4847 REAL(wp) :: ibit25 !< flag indicating 3rd-order scheme along z-direction … … 4381 4853 REAL(wp) :: gv !< Galilei-transformation velocity along y 4382 4854 REAL(wp) :: u_comp !< advection velocity along x 4855 #ifdef _OPENACC 4856 REAL(wp) :: u_comp_l !< advection velocity along x 4857 #endif 4383 4858 REAL(wp) :: w_comp !< advection velocity along z 4384 4859 4860 REAL(wp) :: diss_s !< discretized artificial dissipation at southward-side of the grid box 4861 REAL(wp) :: flux_s !< discretized 6th-order flux at southward-side of the grid box 4862 #ifndef _OPENACC 4385 4863 REAL(wp), DIMENSION(nzb+1:nzt) :: swap_diss_y_local_v !< discretized artificial dissipation at southward-side of the grid box 4386 4864 REAL(wp), DIMENSION(nzb+1:nzt) :: swap_flux_y_local_v !< discretized 6th-order flux at southward-side of the grid box 4865 #endif 4387 4866 4867 REAL(wp) :: diss_l !< discretized artificial dissipation at leftward-side of the grid box 4868 REAL(wp) :: flux_l !< discretized 6th-order flux at leftward-side of the grid box 4869 #ifndef _OPENACC 4388 4870 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_v !< discretized artificial dissipation at leftward-side of the grid box 4389 4871 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_flux_x_local_v !< discretized 6th-order flux at leftward-side of the grid box 4872 #endif 4390 4873 4391 REAL(wp), DIMENSION(nzb:nzt) :: diss_n !< discretized artificial dissipation at northward-side of the grid box 4392 REAL(wp), DIMENSION(nzb:nzt) :: diss_r !< discretized artificial dissipation at rightward-side of the grid box 4393 REAL(wp), DIMENSION(nzb:nzt) :: diss_t !< discretized artificial dissipation at top of the grid box 4394 REAL(wp), DIMENSION(nzb:nzt) :: flux_n !< discretized 6th-order flux at northward-side of the grid box 4395 REAL(wp), DIMENSION(nzb:nzt) :: flux_r !< discretized 6th-order flux at rightward-side of the grid box 4396 REAL(wp), DIMENSION(nzb:nzt) :: flux_t !< discretized 6th-order flux at top of the grid box 4397 REAL(wp), DIMENSION(nzb:nzt) :: v_comp !< advection velocity along y 4874 REAL(wp) :: diss_n !< discretized artificial dissipation at northward-side of the grid box 4875 REAL(wp) :: diss_r !< discretized artificial dissipation at rightward-side of the grid box 4876 REAL(wp) :: diss_t !< discretized artificial dissipation at top of the grid box 4877 REAL(wp) :: flux_n !< discretized 6th-order flux at northward-side of the grid box 4878 REAL(wp) :: flux_r !< discretized 6th-order flux at rightward-side of the grid box 4879 REAL(wp) :: flux_t !< discretized 6th-order flux at top of the grid box 4880 REAL(wp) :: v_comp !< advection velocity along y 4881 #ifdef _OPENACC 4882 REAL(wp) :: v_comp_s !< 4883 #endif 4398 4884 4399 4885 gu = 2.0_wp * u_gtrans 4400 4886 gv = 2.0_wp * v_gtrans 4887 4888 #ifndef _OPENACC 4401 4889 ! 4402 4890 !-- First compute the whole left boundary of the processor domain … … 4457 4945 4458 4946 ENDDO 4459 4947 #endif 4948 4949 !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) & 4950 !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) & 4951 !$ACC PRIVATE(ibit18, ibit19, ibit20, ibit21, ibit22, ibit23) & 4952 !$ACC PRIVATE(ibit18_l, ibit19_l, ibit20_l) & 4953 !$ACC PRIVATE(ibit21_s, ibit22_s, ibit23_s) & 4954 !$ACC PRIVATE(ibit24, ibit25, ibit26) & 4955 !$ACC PRIVATE(flux_r, diss_r, flux_l, diss_l) & 4956 !$ACC PRIVATE(flux_n, diss_n, flux_s, diss_s) & 4957 !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) & 4958 !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) & 4959 !$ACC PRESENT(advc_flags_1) & 4960 !$ACC PRESENT(u, v, w) & 4961 !$ACC PRESENT(drho_air, rho_air_zw, ddzw) & 4962 !$ACC PRESENT(tend) & 4963 !$ACC PRESENT(hom(nzb+1:nzb_max,1,2:3,0)) & 4964 !$ACC PRESENT(weight_substep(intermediate_timestep_count)) & 4965 !$ACC PRESENT(sums_vs2_ws_l, sums_wsvs_ws_l) 4460 4966 DO i = nxl, nxr 4461 4967 4968 #ifndef _OPENACC 4462 4969 j = nysv 4463 4970 DO k = nzb+1, nzb_max … … 4467 4974 ibit21 = REAL( IBITS(advc_flags_1(k,j-1,i),21,1), KIND = wp ) 4468 4975 4469 v_comp (k)= v(k,j,i) + v(k,j-1,i) - gv4470 swap_flux_y_local_v(k) = v_comp (k) * (&4976 v_comp = v(k,j,i) + v(k,j-1,i) - gv 4977 swap_flux_y_local_v(k) = v_comp * ( & 4471 4978 ( 37.0_wp * ibit23 * adv_mom_5 & 4472 4979 + 7.0_wp * ibit22 * adv_mom_3 & … … 4483 4990 ) 4484 4991 4485 swap_diss_y_local_v(k) = - ABS( v_comp (k) ) * (&4992 swap_diss_y_local_v(k) = - ABS( v_comp ) * ( & 4486 4993 ( 10.0_wp * ibit23 * adv_mom_5 & 4487 4994 + 3.0_wp * ibit22 * adv_mom_3 & … … 4502 5009 DO k = nzb_max+1, nzt 4503 5010 4504 v_comp (k)= v(k,j,i) + v(k,j-1,i) - gv4505 swap_flux_y_local_v(k) = v_comp (k) * (&5011 v_comp = v(k,j,i) + v(k,j-1,i) - gv 5012 swap_flux_y_local_v(k) = v_comp * ( & 4506 5013 37.0_wp * ( v(k,j,i) + v(k,j-1,i) ) & 4507 5014 - 8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) ) & 4508 5015 + ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5 4509 swap_diss_y_local_v(k) = - ABS( v_comp (k) ) * (&5016 swap_diss_y_local_v(k) = - ABS( v_comp ) * ( & 4510 5017 10.0_wp * ( v(k,j,i) - v(k,j-1,i) ) & 4511 5018 - 5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) ) & … … 4513 5020 4514 5021 ENDDO 5022 #endif 4515 5023 4516 5024 DO j = nysv, nyn 4517 5025 4518 flux_t(0) = 0.0_wp4519 diss_t(0) = 0.0_wp4520 5026 flux_d = 0.0_wp 4521 5027 diss_d = 0.0_wp … … 4527 5033 ibit18 = REAL( IBITS(advc_flags_1(k,j,i),18,1), KIND = wp ) 4528 5034 4529 u_comp 4530 flux_r (k) = u_comp * (&5035 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 5036 flux_r = u_comp * ( & 4531 5037 ( 37.0_wp * ibit20 * adv_mom_5 & 4532 5038 + 7.0_wp * ibit19 * adv_mom_3 & … … 4543 5049 ) 4544 5050 4545 diss_r (k) = - ABS( u_comp ) * (&5051 diss_r = - ABS( u_comp ) * ( & 4546 5052 ( 10.0_wp * ibit20 * adv_mom_5 & 4547 5053 + 3.0_wp * ibit19 * adv_mom_3 & … … 4558 5064 ) 4559 5065 5066 #ifdef _OPENACC 5067 ! 5068 !-- Recompute the left fluxes. 5069 ibit20_l = REAL( IBITS(advc_flags_1(k,j,i-1),20,1), KIND = wp ) 5070 ibit19_l = REAL( IBITS(advc_flags_1(k,j,i-1),19,1), KIND = wp ) 5071 ibit18_l = REAL( IBITS(advc_flags_1(k,j,i-1),18,1), KIND = wp ) 5072 5073 u_comp_l = u(k,j-1,i) + u(k,j,i) - gu 5074 flux_l = u_comp_l * ( & 5075 ( 37.0_wp * ibit20_l * adv_mom_5 & 5076 + 7.0_wp * ibit19_l * adv_mom_3 & 5077 + ibit18_l * adv_mom_1 & 5078 ) * & 5079 ( v(k,j,i) + v(k,j,i-1) ) & 5080 - ( 8.0_wp * ibit20_l * adv_mom_5 & 5081 + ibit19_l * adv_mom_3 & 5082 ) * & 5083 ( v(k,j,i+1) + v(k,j,i-2) ) & 5084 + ( ibit20_l * adv_mom_5 & 5085 ) * & 5086 ( v(k,j,i+2) + v(k,j,i-3) ) & 5087 ) 5088 5089 diss_l = - ABS( u_comp_l ) * ( & 5090 ( 10.0_wp * ibit20_l * adv_mom_5 & 5091 + 3.0_wp * ibit19_l * adv_mom_3 & 5092 + ibit18_l * adv_mom_1 & 5093 ) * & 5094 ( v(k,j,i) - v(k,j,i-1) ) & 5095 - ( 5.0_wp * ibit20_l * adv_mom_5 & 5096 + ibit19_l * adv_mom_3 & 5097 ) * & 5098 ( v(k,j,i+1) - v(k,j,i-2) ) & 5099 + ( ibit20_l * adv_mom_5 & 5100 ) * & 5101 ( v(k,j,i+2) - v(k,j,i-3) ) & 5102 ) 5103 #else 5104 flux_l = swap_flux_x_local_v(k,j) 5105 diss_l = swap_diss_x_local_v(k,j) 5106 #endif 5107 4560 5108 ibit23 = REAL( IBITS(advc_flags_1(k,j,i),23,1), KIND = wp ) 4561 5109 ibit22 = REAL( IBITS(advc_flags_1(k,j,i),22,1), KIND = wp ) 4562 5110 ibit21 = REAL( IBITS(advc_flags_1(k,j,i),21,1), KIND = wp ) 4563 5111 4564 v_comp (k)= v(k,j+1,i) + v(k,j,i)4565 flux_n (k) = ( v_comp(k) - gv ) * (&5112 v_comp = v(k,j+1,i) + v(k,j,i) 5113 flux_n = ( v_comp - gv ) * ( & 4566 5114 ( 37.0_wp * ibit23 * adv_mom_5 & 4567 5115 + 7.0_wp * ibit22 * adv_mom_3 & … … 4578 5126 ) 4579 5127 4580 diss_n (k) = - ABS( v_comp(k) - gv ) * (&5128 diss_n = - ABS( v_comp - gv ) * ( & 4581 5129 ( 10.0_wp * ibit23 * adv_mom_5 & 4582 5130 + 3.0_wp * ibit22 * adv_mom_3 & … … 4592 5140 ( v(k,j+3,i) - v(k,j-2,i) ) & 4593 5141 ) 5142 5143 #ifdef _OPENACC 5144 ! 5145 !-- Recompute the south fluxes. 5146 ibit23_s = REAL( IBITS(advc_flags_1(k,j-1,i),23,1), KIND = wp ) 5147 ibit22_s = REAL( IBITS(advc_flags_1(k,j-1,i),22,1), KIND = wp ) 5148 ibit21_s = REAL( IBITS(advc_flags_1(k,j-1,i),21,1), KIND = wp ) 5149 5150 v_comp_s = v(k,j,i) + v(k,j-1,i) - gv 5151 flux_s = v_comp_s * ( & 5152 ( 37.0_wp * ibit23_s * adv_mom_5 & 5153 + 7.0_wp * ibit22_s * adv_mom_3 & 5154 + ibit21_s * adv_mom_1 & 5155 ) * & 5156 ( v(k,j,i) + v(k,j-1,i) ) & 5157 - ( 8.0_wp * ibit23_s * adv_mom_5 & 5158 + ibit22_s * adv_mom_3 & 5159 ) * & 5160 ( v(k,j+1,i) + v(k,j-2,i) ) & 5161 + ( ibit23_s * adv_mom_5 & 5162 ) * & 5163 ( v(k,j+2,i) + v(k,j-3,i) ) & 5164 ) 5165 5166 diss_s = - ABS( v_comp_s ) * ( & 5167 ( 10.0_wp * ibit23_s * adv_mom_5 & 5168 + 3.0_wp * ibit22_s * adv_mom_3 & 5169 + ibit21_s * adv_mom_1 & 5170 ) * & 5171 ( v(k,j,i) - v(k,j-1,i) ) & 5172 - ( 5.0_wp * ibit23_s * adv_mom_5 & 5173 + ibit22_s * adv_mom_3 & 5174 ) * & 5175 ( v(k,j+1,i) - v(k,j-2,i) ) & 5176 + ( ibit23_s * adv_mom_5 & 5177 ) * & 5178 ( v(k,j+2,i) - v(k,j-3,i) ) & 5179 ) 5180 #else 5181 flux_s = swap_flux_y_local_v(k) 5182 diss_s = swap_diss_y_local_v(k) 5183 #endif 5184 4594 5185 ! 4595 5186 !-- k index has to be modified near bottom and top, else array … … 4603 5194 k_mm = k - 2 * ibit26 4604 5195 4605 w_comp 4606 flux_t (k) = w_comp * rho_air_zw(k) * (&5196 w_comp = w(k,j-1,i) + w(k,j,i) 5197 flux_t = w_comp * rho_air_zw(k) * ( & 4607 5198 ( 37.0_wp * ibit26 * adv_mom_5 & 4608 5199 + 7.0_wp * ibit25 * adv_mom_3 & … … 4619 5210 ) 4620 5211 4621 diss_t (k) = - ABS( w_comp ) * rho_air_zw(k) * (&5212 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( & 4622 5213 ( 10.0_wp * ibit26 * adv_mom_5 & 4623 5214 + 3.0_wp * ibit25 * adv_mom_3 & … … 4646 5237 ) & 4647 5238 ) * ddx & 4648 + ( v_comp (k)&5239 + ( v_comp & 4649 5240 * ( ibit21 + ibit22 + ibit23 ) & 4650 5241 - ( v(k,j,i) + v(k,j-1,i) ) & … … 4668 5259 4669 5260 tend(k,j,i) = tend(k,j,i) - ( & 4670 ( flux_r(k) + diss_r(k) & 4671 - swap_flux_x_local_v(k,j) - swap_diss_x_local_v(k,j) & 4672 ) * ddx & 4673 + ( flux_n(k) + diss_n(k) & 4674 - swap_flux_y_local_v(k) - swap_diss_y_local_v(k) & 4675 ) * ddy & 4676 + ( ( flux_t(k) + diss_t(k) ) & 4677 - ( flux_d + diss_d ) & 4678 ) * drho_air(k) * ddzw(k) & 5261 ( ( flux_r + diss_r ) & 5262 - ( flux_l + diss_l ) ) * ddx & 5263 + ( ( flux_n + diss_n ) & 5264 - ( flux_s + diss_s ) ) * ddy & 5265 + ( ( flux_t + diss_t ) & 5266 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) & 4679 5267 ) + v(k,j,i) * div 4680 5268 4681 swap_flux_x_local_v(k,j) = flux_r(k) 4682 swap_diss_x_local_v(k,j) = diss_r(k) 4683 swap_flux_y_local_v(k) = flux_n(k) 4684 swap_diss_y_local_v(k) = diss_n(k) 4685 flux_d = flux_t(k) 4686 diss_d = diss_t(k) 5269 #ifndef _OPENACC 5270 swap_flux_x_local_v(k,j) = flux_r 5271 swap_diss_x_local_v(k,j) = diss_r 5272 swap_flux_y_local_v(k) = flux_n 5273 swap_diss_y_local_v(k) = diss_n 5274 #endif 5275 flux_d = flux_t 5276 diss_d = diss_t 4687 5277 4688 5278 ! 4689 5279 !-- Statistical Evaluation of v'v'. The factor has to be applied 4690 5280 !-- for right evaluation when gallilei_trans = .T. . 5281 !$ACC ATOMIC 4691 5282 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 4692 + ( flux_n (k)&4693 * ( v_comp (k) - 2.0_wp * hom(k,1,2,0) )&4694 / ( v_comp (k) - gv + SIGN( 1.0E-20_wp, v_comp(k) - gv ) )&4695 + diss_n (k)&4696 * ABS( v_comp (k) - 2.0_wp * hom(k,1,2,0) )&4697 / ( ABS( v_comp (k) - gv ) + 1.0E-20_wp )&5283 + ( flux_n & 5284 * ( v_comp - 2.0_wp * hom(k,1,2,0) ) & 5285 / ( v_comp - gv + SIGN( 1.0E-20_wp, v_comp - gv ) ) & 5286 + diss_n & 5287 * ABS( v_comp - 2.0_wp * hom(k,1,2,0) ) & 5288 / ( ABS( v_comp - gv ) + 1.0E-20_wp ) & 4698 5289 ) * weight_substep(intermediate_timestep_count) 4699 5290 ! 4700 5291 !-- Statistical Evaluation of w'u'. 5292 !$ACC ATOMIC 4701 5293 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) & 4702 + ( flux_t (k)&5294 + ( flux_t & 4703 5295 * ( w_comp - 2.0_wp * hom(k,1,3,0) ) & 4704 5296 / ( w_comp + SIGN( 1.0E-20_wp, w_comp ) ) & 4705 + diss_t (k)&5297 + diss_t & 4706 5298 * ABS( w_comp - 2.0_wp * hom(k,1,3,0) ) & 4707 5299 / ( ABS( w_comp ) + 1.0E-20_wp ) & … … 4712 5304 DO k = nzb_max+1, nzt 4713 5305 4714 u_comp 4715 flux_r (k) = u_comp * (&5306 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 5307 flux_r = u_comp * ( & 4716 5308 37.0_wp * ( v(k,j,i+1) + v(k,j,i) ) & 4717 5309 - 8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) ) & 4718 5310 + ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5 4719 5311 4720 diss_r (k) = - ABS( u_comp ) * (&5312 diss_r = - ABS( u_comp ) * ( & 4721 5313 10.0_wp * ( v(k,j,i+1) - v(k,j,i) ) & 4722 5314 - 5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) ) & 4723 5315 + ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5 4724 5316 4725 4726 v_comp(k) = v(k,j+1,i) + v(k,j,i) 4727 flux_n(k) = ( v_comp(k) - gv ) * ( & 5317 #ifdef _OPENACC 5318 ! 5319 !-- Recompute the left fluxes. 5320 u_comp_l = u(k,j-1,i) + u(k,j,i) - gu 5321 flux_l = u_comp_l * ( & 5322 37.0_wp * ( v(k,j,i) + v(k,j,i-1) ) & 5323 - 8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) ) & 5324 + ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5 5325 diss_l = - ABS( u_comp_l ) * ( & 5326 10.0_wp * ( v(k,j,i) - v(k,j,i-1) ) & 5327 - 5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) ) & 5328 + ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5 5329 #else 5330 flux_l = swap_flux_x_local_v(k,j) 5331 diss_l = swap_diss_x_local_v(k,j) 5332 #endif 5333 5334 v_comp = v(k,j+1,i) + v(k,j,i) 5335 flux_n = ( v_comp - gv ) * ( & 4728 5336 37.0_wp * ( v(k,j+1,i) + v(k,j,i) ) & 4729 5337 - 8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) ) & 4730 5338 + ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5 4731 5339 4732 diss_n (k) = - ABS( v_comp(k) - gv ) * (&5340 diss_n = - ABS( v_comp - gv ) * ( & 4733 5341 10.0_wp * ( v(k,j+1,i) - v(k,j,i) ) & 4734 5342 - 5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) ) & 4735 5343 + ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5 5344 5345 #ifdef _OPENACC 5346 ! 5347 !-- Recompute the south fluxes. 5348 v_comp_s = v(k,j,i) + v(k,j-1,i) - gv 5349 flux_s = v_comp_s * ( & 5350 37.0_wp * ( v(k,j,i) + v(k,j-1,i) ) & 5351 - 8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) ) & 5352 + ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5 5353 diss_s = - ABS( v_comp_s ) * ( & 5354 10.0_wp * ( v(k,j,i) - v(k,j-1,i) ) & 5355 - 5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) ) & 5356 + ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5 5357 #else 5358 flux_s = swap_flux_y_local_v(k) 5359 diss_s = swap_diss_y_local_v(k) 5360 #endif 5361 4736 5362 ! 4737 5363 !-- k index has to be modified near bottom and top, else array … … 4745 5371 k_mm = k - 2 * ibit26 4746 5372 4747 w_comp 4748 flux_t (k) = w_comp * rho_air_zw(k) * (&5373 w_comp = w(k,j-1,i) + w(k,j,i) 5374 flux_t = w_comp * rho_air_zw(k) * ( & 4749 5375 ( 37.0_wp * ibit26 * adv_mom_5 & 4750 5376 + 7.0_wp * ibit25 * adv_mom_3 & … … 4761 5387 ) 4762 5388 4763 diss_t (k) = - ABS( w_comp ) * rho_air_zw(k) * (&5389 diss_t = - ABS( w_comp ) * rho_air_zw(k) * ( & 4764 5390 ( 10.0_wp * ibit26 * adv_mom_5 & 4765 5391 + 3.0_wp * ibit25 * adv_mom_3 & … … 4780 5406 !-- by a not sufficient reduction of divergences near topography. 4781 5407 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx & 4782 + ( v_comp (k)- ( v(k,j,i) + v(k,j-1,i) ) ) * ddy &5408 + ( v_comp - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy & 4783 5409 + ( w_comp * rho_air_zw(k) - & 4784 5410 ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & … … 4787 5413 4788 5414 tend(k,j,i) = tend(k,j,i) - ( & 4789 ( flux_r(k) + diss_r(k) & 4790 - swap_flux_x_local_v(k,j) - swap_diss_x_local_v(k,j) & 4791 ) * ddx & 4792 + ( flux_n(k) + diss_n(k) & 4793 - swap_flux_y_local_v(k) - swap_diss_y_local_v(k) & 4794 ) * ddy & 4795 + ( ( flux_t(k) + diss_t(k) ) & 4796 - ( flux_d + diss_d ) & 4797 ) * drho_air(k) * ddzw(k) & 5415 ( ( flux_r + diss_r ) & 5416 - ( flux_l + diss_l ) ) * ddx & 5417 + ( ( flux_n + diss_n ) & 5418 - ( flux_s + diss_s ) ) * ddy & 5419 + ( ( flux_t + diss_t ) & 5420 - ( flux_d + diss_d ) ) * drho_air(k) * ddzw(k) & 4798 5421 ) + v(k,j,i) * div 4799 5422 4800 swap_flux_x_local_v(k,j) = flux_r(k) 4801 swap_diss_x_local_v(k,j) = diss_r(k) 4802 swap_flux_y_local_v(k) = flux_n(k) 4803 swap_diss_y_local_v(k) = diss_n(k) 4804 flux_d = flux_t(k) 4805 diss_d = diss_t(k) 5423 #ifndef _OPENACC 5424 swap_flux_x_local_v(k,j) = flux_r 5425 swap_diss_x_local_v(k,j) = diss_r 5426 swap_flux_y_local_v(k) = flux_n 5427 swap_diss_y_local_v(k) = diss_n 5428 #endif 5429 flux_d = flux_t 5430 diss_d = diss_t 4806 5431 4807 5432 ! 4808 5433 !-- Statistical Evaluation of v'v'. The factor has to be applied 4809 5434 !-- for right evaluation when gallilei_trans = .T. . 5435 !$ACC ATOMIC 4810 5436 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 4811 + ( flux_n (k)&4812 * ( v_comp (k) - 2.0_wp * hom(k,1,2,0) )&4813 / ( v_comp (k) - gv + SIGN( 1.0E-20_wp, v_comp(k) - gv ) )&4814 + diss_n (k)&4815 * ABS( v_comp (k) - 2.0_wp * hom(k,1,2,0) )&4816 / ( ABS( v_comp (k) - gv ) + 1.0E-20_wp )&5437 + ( flux_n & 5438 * ( v_comp - 2.0_wp * hom(k,1,2,0) ) & 5439 / ( v_comp - gv + SIGN( 1.0E-20_wp, v_comp - gv ) ) & 5440 + diss_n & 5441 * ABS( v_comp - 2.0_wp * hom(k,1,2,0) ) & 5442 / ( ABS( v_comp - gv ) + 1.0E-20_wp ) & 4817 5443 ) * weight_substep(intermediate_timestep_count) 4818 5444 ! 4819 5445 !-- Statistical Evaluation of w'u'. 5446 !$ACC ATOMIC 4820 5447 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) & 4821 + ( flux_t (k)&5448 + ( flux_t & 4822 5449 * ( w_comp - 2.0_wp * hom(k,1,3,0) ) & 4823 5450 / ( w_comp + SIGN( 1.0E-20_wp, w_comp ) ) & 4824 + diss_t (k)&5451 + diss_t & 4825 5452 * ABS( w_comp - 2.0_wp * hom(k,1,3,0) ) & 4826 5453 / ( ABS( w_comp ) + 1.0E-20_wp ) & … … 4830 5457 ENDDO 4831 5458 ENDDO 5459 !$ACC UPDATE HOST(sums_vs2_ws_l(nzb+1,tn)) 4832 5460 sums_vs2_ws_l(nzb,tn) = sums_vs2_ws_l(nzb+1,tn) 5461 !$ACC UPDATE DEVICE(sums_vs2_ws_l(nzb,tn)) 4833 5462 4834 5463 … … 4874 5503 REAL(wp) :: ibit28 !< flag indicating 3rd-order scheme along x-direction 4875 5504 REAL(wp) :: ibit29 !< flag indicating 5th-order scheme along x-direction 5505 #ifdef _OPENACC 5506 REAL(wp) :: ibit27_l !< flag indicating 1st-order scheme along x-direction 5507 REAL(wp) :: ibit28_l !< flag indicating 3rd-order scheme along x-direction 5508 REAL(wp) :: ibit29_l !< flag indicating 5th-order scheme along x-direction 5509 #endif 4876 5510 REAL(wp) :: ibit30 !< flag indicating 1st-order scheme along y-direction 4877 5511 REAL(wp) :: ibit31 !< flag indicating 3rd-order scheme along y-direction 4878 5512 REAL(wp) :: ibit32 !< flag indicating 5th-order scheme along y-direction 5513 #ifdef _OPENACC 5514 REAL(wp) :: ibit30_s !< flag indicating 1st-order scheme along y-direction 5515 REAL(wp) :: ibit31_s !< flag indicating 3rd-order scheme along y-direction 5516 REAL(wp) :: ibit32_s !< flag indicating 5th-order scheme along y-direction 5517 #endif 4879 5518 REAL(wp) :: ibit33 !< flag indicating 1st-order scheme along z-direction 4880 5519 REAL(wp) :: ibit34 !< flag indicating 3rd-order scheme along z-direction … … 4886 5525 REAL(wp) :: gv !< Galilei-transformation velocity along y 4887 5526 REAL(wp) :: u_comp !< advection velocity along x 5527 #ifdef _OPENACC 5528 REAL(wp) :: u_comp_l !< advection velocity along x 5529 #endif 4888 5530 REAL(wp) :: v_comp !< advection velocity along y 5531 #ifdef _OPENACC 5532 REAL(wp) :: v_comp_s !< advection velocity along y 5533 #endif 4889 5534 REAL(wp) :: w_comp !< advection velocity along z 4890 5535 4891 REAL(wp) , DIMENSION(nzb:nzt):: diss_t !< discretized artificial dissipation at top of the grid box4892 REAL(wp) , DIMENSION(nzb:nzt):: flux_t !< discretized 6th-order flux at top of the grid box5536 REAL(wp) :: diss_t !< discretized artificial dissipation at top of the grid box 5537 REAL(wp) :: flux_t !< discretized 6th-order flux at top of the grid box 4893 5538 4894 REAL(wp), DIMENSION(nzb+1:nzt) :: diss_n !< discretized artificial dissipation at northward-side of the grid box 4895 REAL(wp), DIMENSION(nzb+1:nzt) :: diss_r !< discretized artificial dissipation at rightward-side of the grid box 4896 REAL(wp), DIMENSION(nzb+1:nzt) :: flux_n !< discretized 6th-order flux at northward-side of the grid box 4897 REAL(wp), DIMENSION(nzb+1:nzt) :: flux_r !< discretized 6th-order flux at rightward-side of the grid box 5539 REAL(wp) :: diss_n !< discretized artificial dissipation at northward-side of the grid box 5540 REAL(wp) :: diss_r !< discretized artificial dissipation at rightward-side of the grid box 5541 REAL(wp) :: flux_n !< discretized 6th-order flux at northward-side of the grid box 5542 REAL(wp) :: flux_r !< discretized 6th-order flux at rightward-side of the grid box 5543 5544 REAL(wp) :: diss_s !< discretized artificial dissipation at southward-side of the grid box 5545 REAL(wp) :: flux_s !< discretized 6th-order flux at southward-side of the grid box 5546 #ifndef _OPENACC 4898 5547 REAL(wp), DIMENSION(nzb+1:nzt) :: swap_diss_y_local_w !< discretized artificial dissipation at southward-side of the grid box 4899 5548 REAL(wp), DIMENSION(nzb+1:nzt) :: swap_flux_y_local_w !< discretized 6th-order flux at southward-side of the grid box 5549 #endif 4900 5550 5551 REAL(wp) :: diss_l !< discretized artificial dissipation at leftward-side of the grid box 5552 REAL(wp) :: flux_l !< discretized 6th-order flux at leftward-side of the grid box 5553 #ifndef _OPENACC 4901 5554 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_diss_x_local_w !< discretized artificial dissipation at leftward-side of the grid box 4902 5555 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_flux_x_local_w !< discretized 6th-order flux at leftward-side of the grid box 5556 #endif 4903 5557 4904 5558 gu = 2.0_wp * u_gtrans 4905 5559 gv = 2.0_wp * v_gtrans 5560 5561 #ifndef _OPENACC 4906 5562 ! 4907 5563 !-- compute the whole left boundary of the processor domain … … 4962 5618 4963 5619 ENDDO 4964 5620 #endif 5621 5622 !$ACC PARALLEL LOOP COLLAPSE(2) FIRSTPRIVATE(tn, gu, gv) & 5623 !$ACC PRIVATE(i, j, k, k_mm, k_pp, k_ppp) & 5624 !$ACC PRIVATE(ibit27, ibit28, ibit29, ibit30, ibit31, ibit32) & 5625 !$ACC PRIVATE(ibit27_l, ibit28_l, ibit29_l) & 5626 !$ACC PRIVATE(ibit30_s, ibit31_s, ibit32_s) & 5627 !$ACC PRIVATE(ibit33, ibit34, ibit35) & 5628 !$ACC PRIVATE(flux_r, diss_r, flux_l, diss_l) & 5629 !$ACC PRIVATE(flux_n, diss_n, flux_s, diss_s) & 5630 !$ACC PRIVATE(flux_t, diss_t, flux_d, diss_d) & 5631 !$ACC PRIVATE(div, u_comp, u_comp_l, v_comp, v_comp_s, w_comp) & 5632 !$ACC PRESENT(advc_flags_1, advc_flags_2) & 5633 !$ACC PRESENT(u, v, w) & 5634 !$ACC PRESENT(rho_air, drho_air_zw, ddzu) & 5635 !$ACC PRESENT(tend) & 5636 !$ACC PRESENT(hom(nzb+1:nzb_max,1,3,0)) & 5637 !$ACC PRESENT(weight_substep(intermediate_timestep_count)) & 5638 !$ACC PRESENT(sums_ws2_ws_l(nzb+1:nzb_max,0)) 4965 5639 DO i = nxl, nxr 4966 5640 5641 #ifndef _OPENACC 4967 5642 j = nys 4968 5643 DO k = nzb+1, nzb_max … … 5018 5693 5019 5694 ENDDO 5695 #endif 5020 5696 5021 5697 DO j = nys, nyn … … 5025 5701 !-- at the first w-level. For topography wall this is done implicitely 5026 5702 !-- by advc_flags_1. 5027 k = nzb + 1 5028 w_comp = w(k,j,i) + w(k-1,j,i) 5029 flux_t(0) = w_comp * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1 5030 diss_t(0) = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1 5031 flux_d = flux_t(0) 5032 diss_d = diss_t(0) 5703 k = nzb + 1 5704 w_comp = w(k,j,i) + w(k-1,j,i) 5705 flux_d = w_comp * ( w(k,j,i) + w(k-1,j,i) ) * adv_mom_1 5706 diss_d = -ABS(w_comp) * ( w(k,j,i) - w(k-1,j,i) ) * adv_mom_1 5033 5707 5034 5708 DO k = nzb+1, nzb_max … … 5038 5712 ibit27 = REAL( IBITS(advc_flags_1(k,j,i),27,1), KIND = wp ) 5039 5713 5040 u_comp 5041 flux_r (k) = u_comp * (&5714 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 5715 flux_r = u_comp * ( & 5042 5716 ( 37.0_wp * ibit29 * adv_mom_5 & 5043 5717 + 7.0_wp * ibit28 * adv_mom_3 & … … 5054 5728 ) 5055 5729 5056 diss_r (k) = - ABS( u_comp ) * (&5730 diss_r = - ABS( u_comp ) * ( & 5057 5731 ( 10.0_wp * ibit29 * adv_mom_5 & 5058 5732 + 3.0_wp * ibit28 * adv_mom_3 & … … 5069 5743 ) 5070 5744 5745 #ifdef _OPENACC 5746 ! 5747 !-- Recompute the left fluxes. 5748 ibit29_l = REAL( IBITS(advc_flags_1(k,j,i-1),29,1), KIND = wp ) 5749 ibit28_l = REAL( IBITS(advc_flags_1(k,j,i-1),28,1), KIND = wp ) 5750 ibit27_l = REAL( IBITS(advc_flags_1(k,j,i-1),27,1), KIND = wp ) 5751 5752 u_comp_l = u(k+1,j,i) + u(k,j,i) - gu 5753 flux_l = u_comp_l * ( & 5754 ( 37.0_wp * ibit29_l * adv_mom_5 & 5755 + 7.0_wp * ibit28_l * adv_mom_3 & 5756 + ibit27_l * adv_mom_1 & 5757 ) * & 5758 ( w(k,j,i) + w(k,j,i-1) ) & 5759 - ( 8.0_wp * ibit29_l * adv_mom_5 & 5760 + ibit28_l * adv_mom_3 & 5761 ) * & 5762 ( w(k,j,i+1) + w(k,j,i-2) ) & 5763 + ( ibit29_l * adv_mom_5 & 5764 ) * & 5765 ( w(k,j,i+2) + w(k,j,i-3) ) & 5766 ) 5767 5768 diss_l = - ABS( u_comp_l ) * ( & 5769 ( 10.0_wp * ibit29_l * adv_mom_5 & 5770 + 3.0_wp * ibit28_l * adv_mom_3 & 5771 + ibit27_l * adv_mom_1 & 5772 ) * & 5773 ( w(k,j,i) - w(k,j,i-1) ) & 5774 - ( 5.0_wp * ibit29_l * adv_mom_5 & 5775 + ibit28_l * adv_mom_3 & 5776 ) * & 5777 ( w(k,j,i+1) - w(k,j,i-2) ) & 5778 + ( ibit29_l * adv_mom_5 & 5779 ) * & 5780 ( w(k,j,i+2) - w(k,j,i-3) ) & 5781 ) 5782 #else 5783 flux_l = swap_flux_x_local_w(k,j) 5784 diss_l = swap_diss_x_local_w(k,j) 5785 #endif 5786 5787 5071 5788 ibit32 = REAL( IBITS(advc_flags_2(k,j,i),0,1), KIND = wp ) 5072 5789 ibit31 = REAL( IBITS(advc_flags_1(k,j,i),31,1), KIND = wp ) 5073 5790 ibit30 = REAL( IBITS(advc_flags_1(k,j,i),30,1), KIND = wp ) 5074 5791 5075 v_comp 5076 flux_n (k) = v_comp * (&5792 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 5793 flux_n = v_comp * ( & 5077 5794 ( 37.0_wp * ibit32 * adv_mom_5 & 5078 5795 + 7.0_wp * ibit31 * adv_mom_3 & … … 5089 5806 ) 5090 5807 5091 diss_n (k) = - ABS( v_comp ) * (&5808 diss_n = - ABS( v_comp ) * ( & 5092 5809 ( 10.0_wp * ibit32 * adv_mom_5 & 5093 5810 + 3.0_wp * ibit31 * adv_mom_3 & … … 5103 5820 ( w(k,j+3,i) - w(k,j-2,i) ) & 5104 5821 ) 5822 5823 #ifdef _OPENACC 5824 ! 5825 !-- Recompute the south fluxes. 5826 ibit32_s = REAL( IBITS(advc_flags_2(k,j-1,i),0,1), KIND = wp ) 5827 ibit31_s = REAL( IBITS(advc_flags_1(k,j-1,i),31,1), KIND = wp ) 5828 ibit30_s = REAL( IBITS(advc_flags_1(k,j-1,i),30,1), KIND = wp ) 5829 5830 v_comp_s = v(k+1,j,i) + v(k,j,i) - gv 5831 flux_s = v_comp_s * ( & 5832 ( 37.0_wp * ibit32_s * adv_mom_5 & 5833 + 7.0_wp * ibit31_s * adv_mom_3 & 5834 + ibit30_s * adv_mom_1 & 5835 ) * & 5836 ( w(k,j,i) + w(k,j-1,i) ) & 5837 - ( 8.0_wp * ibit32_s * adv_mom_5 & 5838 + ibit31_s * adv_mom_3 & 5839 ) * & 5840 ( w(k,j+1,i) + w(k,j-2,i) ) & 5841 + ( ibit32_s * adv_mom_5 & 5842 ) * & 5843 ( w(k,j+2,i) + w(k,j-3,i) ) & 5844 ) 5845 5846 diss_s = - ABS( v_comp_s ) * ( & 5847 ( 10.0_wp * ibit32_s * adv_mom_5 & 5848 + 3.0_wp * ibit31_s * adv_mom_3 & 5849 + ibit30_s * adv_mom_1 & 5850 ) * & 5851 ( w(k,j,i) - w(k,j-1,i) ) & 5852 - ( 5.0_wp * ibit32_s * adv_mom_5 & 5853 + ibit31_s * adv_mom_3 & 5854 ) * & 5855 ( w(k,j+1,i) - w(k,j-2,i) ) & 5856 + ( ibit32_s * adv_mom_5 & 5857 ) * & 5858 ( w(k,j+2,i) - w(k,j-3,i) ) & 5859 ) 5860 #else 5861 flux_s = swap_flux_y_local_w(k) 5862 diss_s = swap_diss_y_local_w(k) 5863 #endif 5864 5105 5865 ! 5106 5866 !-- k index has to be modified near bottom and top, else array … … 5114 5874 k_mm = k - 2 * ibit35 5115 5875 5116 w_comp 5117 flux_t (k) = w_comp * rho_air(k+1) * (&5876 w_comp = w(k+1,j,i) + w(k,j,i) 5877 flux_t = w_comp * rho_air(k+1) * ( & 5118 5878 ( 37.0_wp * ibit35 * adv_mom_5 & 5119 5879 + 7.0_wp * ibit34 * adv_mom_3 & … … 5130 5890 ) 5131 5891 5132 diss_t (k) = - ABS( w_comp ) * rho_air(k+1) * (&5892 diss_t = - ABS( w_comp ) * rho_air(k+1) * ( & 5133 5893 ( 10.0_wp * ibit35 * adv_mom_5 & 5134 5894 + 3.0_wp * ibit34 * adv_mom_3 & … … 5177 5937 5178 5938 tend(k,j,i) = tend(k,j,i) - ( & 5179 ( flux_r(k) + diss_r(k) & 5180 - swap_flux_x_local_w(k,j) - swap_diss_x_local_w(k,j) & 5181 ) * ddx & 5182 + ( flux_n(k) + diss_n(k) & 5183 - swap_flux_y_local_w(k) - swap_diss_y_local_w(k) & 5184 ) * ddy & 5185 + ( ( flux_t(k) + diss_t(k) ) & 5186 - ( flux_d + diss_d ) & 5187 ) * drho_air_zw(k) * ddzu(k+1) & 5939 ( ( flux_r + diss_r ) & 5940 - ( flux_l + diss_l ) ) * ddx & 5941 + ( ( flux_n + diss_n ) & 5942 - ( flux_s + diss_s ) ) * ddy & 5943 + ( ( flux_t + diss_t ) & 5944 - ( flux_d + diss_d ) ) * drho_air_zw(k) * ddzu(k+1) & 5188 5945 ) + div * w(k,j,i) 5189 5946 5190 swap_flux_x_local_w(k,j) = flux_r(k) 5191 swap_diss_x_local_w(k,j) = diss_r(k) 5192 swap_flux_y_local_w(k) = flux_n(k) 5193 swap_diss_y_local_w(k) = diss_n(k) 5194 flux_d = flux_t(k) 5195 diss_d = diss_t(k) 5196 5947 #ifndef _OPENACC 5948 swap_flux_x_local_w(k,j) = flux_r 5949 swap_diss_x_local_w(k,j) = diss_r 5950 swap_flux_y_local_w(k) = flux_n 5951 swap_diss_y_local_w(k) = diss_n 5952 #endif 5953 flux_d = flux_t 5954 diss_d = diss_t 5955 5956 !$ACC ATOMIC 5197 5957 sums_ws2_ws_l(k,tn) = sums_ws2_ws_l(k,tn) & 5198 + ( flux_t (k)&5958 + ( flux_t & 5199 5959 * ( w_comp - 2.0_wp * hom(k,1,3,0) ) & 5200 5960 / ( w_comp + SIGN( 1.0E-20_wp, w_comp ) ) & 5201 + diss_t (k)&5961 + diss_t & 5202 5962 * ABS( w_comp - 2.0_wp * hom(k,1,3,0) ) & 5203 5963 / ( ABS( w_comp ) + 1.0E-20_wp ) & … … 5208 5968 DO k = nzb_max+1, nzt 5209 5969 5210 u_comp 5211 flux_r (k) = u_comp * (&5970 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 5971 flux_r = u_comp * ( & 5212 5972 37.0_wp * ( w(k,j,i+1) + w(k,j,i) ) & 5213 5973 - 8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) ) & 5214 5974 + ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5 5215 5975 5216 diss_r (k) = - ABS( u_comp ) * (&5976 diss_r = - ABS( u_comp ) * ( & 5217 5977 10.0_wp * ( w(k,j,i+1) - w(k,j,i) ) & 5218 5978 - 5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) ) & 5219 5979 + ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5 5220 5980 5221 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 5222 flux_n(k) = v_comp * ( & 5981 #ifdef _OPENACC 5982 ! 5983 !-- Recompute the left fluxes. 5984 u_comp_l = u(k+1,j,i) + u(k,j,i) - gu 5985 flux_l = u_comp_l * ( & 5986 37.0_wp * ( w(k,j,i) + w(k,j,i-1) ) & 5987 - 8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) ) & 5988 + ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5 5989 diss_l = - ABS( u_comp_l ) * ( & 5990 10.0_wp * ( w(k,j,i) - w(k,j,i-1) ) & 5991 - 5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) ) & 5992 + ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5 5993 #else 5994 flux_l = swap_flux_x_local_w(k,j) 5995 diss_l = swap_diss_x_local_w(k,j) 5996 #endif 5997 5998 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 5999 flux_n = v_comp * ( & 5223 6000 37.0_wp * ( w(k,j+1,i) + w(k,j,i) ) & 5224 6001 - 8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) ) & 5225 6002 + ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5 5226 6003 5227 diss_n (k) = - ABS( v_comp ) * (&6004 diss_n = - ABS( v_comp ) * ( & 5228 6005 10.0_wp * ( w(k,j+1,i) - w(k,j,i) ) & 5229 6006 - 5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) ) & 5230 6007 + ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5 6008 6009 #ifdef _OPENACC 6010 ! 6011 !-- Recompute the south fluxes. 6012 v_comp_s = v(k+1,j,i) + v(k,j,i) - gv 6013 flux_s = v_comp_s * ( & 6014 37.0_wp * ( w(k,j,i) + w(k,j-1,i) ) & 6015 - 8.0_wp * ( w(k,j+1,i) +w(k,j-2,i) ) & 6016 + ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5 6017 diss_s = - ABS( v_comp_s ) * ( & 6018 10.0_wp * ( w(k,j,i) - w(k,j-1,i) ) & 6019 - 5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) ) & 6020 + ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5 6021 #else 6022 flux_s = swap_flux_y_local_w(k) 6023 diss_s = swap_diss_y_local_w(k) 6024 #endif 6025 5231 6026 ! 5232 6027 !-- k index has to be modified near bottom and top, else array … … 5240 6035 k_mm = k - 2 * ibit35 5241 6036 5242 w_comp 5243 flux_t (k) = w_comp * rho_air(k+1) * (&6037 w_comp = w(k+1,j,i) + w(k,j,i) 6038 flux_t = w_comp * rho_air(k+1) * ( & 5244 6039 ( 37.0_wp * ibit35 * adv_mom_5 & 5245 6040 + 7.0_wp * ibit34 * adv_mom_3 & … … 5256 6051 ) 5257 6052 5258 diss_t (k) = - ABS( w_comp ) * rho_air(k+1) * (&6053 diss_t = - ABS( w_comp ) * rho_air(k+1) * ( & 5259 6054 ( 10.0_wp * ibit35 * adv_mom_5 & 5260 6055 + 3.0_wp * ibit34 * adv_mom_3 & … … 5282 6077 5283 6078 tend(k,j,i) = tend(k,j,i) - ( & 5284 ( flux_r(k) + diss_r(k) & 5285 - swap_flux_x_local_w(k,j) - swap_diss_x_local_w(k,j) & 5286 ) * ddx & 5287 + ( flux_n(k) + diss_n(k) & 5288 - swap_flux_y_local_w(k) - swap_diss_y_local_w(k) & 5289 ) * ddy & 5290 + ( ( flux_t(k) + diss_t(k) ) & 5291 - ( flux_d + diss_d ) & 5292 ) * drho_air_zw(k) * ddzu(k+1) & 6079 ( ( flux_r + diss_r ) & 6080 - ( flux_l + diss_l ) ) * ddx & 6081 + ( ( flux_n + diss_n ) & 6082 - ( flux_s + diss_s ) ) * ddy & 6083 + ( ( flux_t + diss_t ) & 6084 - ( flux_d + diss_d ) ) * drho_air_zw(k) * ddzu(k+1) & 5293 6085 ) + div * w(k,j,i) 5294 6086 5295 swap_flux_x_local_w(k,j) = flux_r(k) 5296 swap_diss_x_local_w(k,j) = diss_r(k) 5297 swap_flux_y_local_w(k) = flux_n(k) 5298 swap_diss_y_local_w(k) = diss_n(k) 5299 flux_d = flux_t(k) 5300 diss_d = diss_t(k) 5301 6087 #ifndef _OPENACC 6088 swap_flux_x_local_w(k,j) = flux_r 6089 swap_diss_x_local_w(k,j) = diss_r 6090 swap_flux_y_local_w(k) = flux_n 6091 swap_diss_y_local_w(k) = diss_n 6092 #endif 6093 flux_d = flux_t 6094 diss_d = diss_t 6095 6096 !$ACC ATOMIC 5302 6097 sums_ws2_ws_l(k,tn) = sums_ws2_ws_l(k,tn) & 5303 + ( flux_t (k)&6098 + ( flux_t & 5304 6099 * ( w_comp - 2.0_wp * hom(k,1,3,0) ) & 5305 6100 / ( w_comp + SIGN( 1.0E-20_wp, w_comp ) ) & 5306 + diss_t (k)&6101 + diss_t & 5307 6102 * ABS( w_comp - 2.0_wp * hom(k,1,3,0) ) & 5308 6103 / ( ABS( w_comp ) + 1.0E-20_wp ) & -
palm/trunk/SOURCE/basic_constants_and_equations_mod.f90
r3449 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3449 2018-10-29 19:36:56Z suehring 27 30 ! +degc_to_k 28 31 ! … … 58 61 REAL(wp), PARAMETER :: molecular_weight_of_water = 0.01801528_wp !< mol. m. H2O (kg mol-1) 59 62 REAL(wp), PARAMETER :: pi = 3.141592654_wp !< PI 63 !$ACC DECLARE COPYIN(pi) 60 64 REAL(wp), PARAMETER :: rho_l = 1.0E3_wp !< density of water (kg m-3) 61 65 REAL(wp), PARAMETER :: rho_nacl = 2165.0_wp !< density of NaCl (kg m-3) -
palm/trunk/SOURCE/boundary_conds.f90
r3589 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3589 2018-11-30 15:09:51Z suehring 27 30 ! Move the control parameter "salsa" from salsa_mod to control_parameters 28 31 ! (M. Kurppa) … … 289 292 kb = MERGE( -1, 1, l == 0 ) 290 293 !$OMP PARALLEL DO PRIVATE( i, j, k ) 294 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 295 !$ACC PRESENT(bc_h, w_p) 291 296 DO m = 1, bc_h(l)%ns 292 297 i = bc_h(l)%i(m) … … 300 305 !-- Top boundary. A nested domain ( ibc_uv_t = 3 ) does not require settings. 301 306 IF ( ibc_uv_t == 0 ) THEN 307 !$ACC KERNELS PRESENT(u_p, v_p, u_init, v_init) 302 308 u_p(nzt+1,:,:) = u_init(nzt+1) 303 309 v_p(nzt+1,:,:) = v_init(nzt+1) 310 !$ACC END KERNELS 304 311 ELSEIF ( ibc_uv_t == 1 ) THEN 305 312 u_p(nzt+1,:,:) = u_p(nzt,:,:) … … 311 318 IF ( .NOT. child_domain .AND. .NOT. nesting_offline .AND. & 312 319 TRIM(coupling_mode) /= 'vnested_fine' ) THEN 320 !$ACC KERNELS PRESENT(w_p) 313 321 w_p(nzt:nzt+1,:,:) = 0.0_wp !< nzt is not a prognostic level (but cf. pres) 322 !$ACC END KERNELS 314 323 ENDIF 315 324 … … 342 351 kb = MERGE( -1, 1, l == 0 ) 343 352 !$OMP PARALLEL DO PRIVATE( i, j, k ) 353 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 354 !$ACC PRESENT(bc_h, pt_p) 344 355 DO m = 1, bc_h(l)%ns 345 356 i = bc_h(l)%i(m) … … 364 375 pt_p(nzt+1,:,:) = pt_p(nzt,:,:) 365 376 ELSEIF ( ibc_pt_t == 2 ) THEN 377 !$ACC KERNELS PRESENT(pt_p, dzu) 366 378 pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1) 379 !$ACC END KERNELS 367 380 ENDIF 368 381 … … 379 392 kb = MERGE( -1, 1, l == 0 ) 380 393 !$OMP PARALLEL DO PRIVATE( i, j, k ) 394 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 395 !$ACC PRESENT(bc_h, e_p) 381 396 DO m = 1, bc_h(l)%ns 382 397 i = bc_h(l)%i(m) … … 444 459 445 460 IF ( .NOT. child_domain ) THEN 461 !$ACC KERNELS PRESENT(e_p) 446 462 e_p(nzt+1,:,:) = e_p(nzt,:,:) 463 !$ACC END KERNELS 447 464 ! 448 465 !-- Nesting case: if parent operates in RANS mode and child in LES mode, -
palm/trunk/SOURCE/buoyancy.f90
r3538 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3538 2018-11-20 10:55:41Z suehring 27 30 ! Remove unnecessary double-masking of topography 28 31 ! … … 175 178 ! 176 179 !-- Normal case: horizontal surface 180 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 181 !$ACC PRESENT(var) & 182 !$ACC PRESENT(ref_state) & 183 !$ACC PRESENT(tend) 177 184 DO i = nxl, nxr 178 185 DO j = nys, nyn -
palm/trunk/SOURCE/coriolis.f90
r3538 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3538 2018-11-20 10:55:41Z suehring 27 30 ! Note concerning topography masking added 28 31 ! … … 145 148 !-- u-component 146 149 CASE ( 1 ) 150 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) & 151 !$ACC PRESENT(wall_flags_0) & 152 !$ACC PRESENT(v, w, vg) & 153 !$ACC PRESENT(tend) 147 154 DO i = nxlu, nxr 148 155 DO j = nys, nyn … … 167 174 !-- v-component 168 175 CASE ( 2 ) 176 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) & 177 !$ACC PRESENT(wall_flags_0) & 178 !$ACC PRESENT(u, ug) & 179 !$ACC PRESENT(tend) 169 180 DO i = nxl, nxr 170 181 DO j = nysv, nyn … … 185 196 !-- w-component 186 197 CASE ( 3 ) 198 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) & 199 !$ACC PRESENT(wall_flags_0) & 200 !$ACC PRESENT(u) & 201 !$ACC PRESENT(tend) 187 202 DO i = nxl, nxr 188 203 DO j = nys, nyn -
palm/trunk/SOURCE/diffusion_s.f90
r3547 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3547 2018-11-21 13:21:24Z suehring 27 30 ! variables documented 28 31 ! … … 194 197 #endif 195 198 199 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, m) & 200 !$ACC PRIVATE(surf_e, surf_s, flag, mask_top, mask_bottom) & 201 !$ACC PRIVATE(mask_north, mask_south, mask_west, mask_east) & 202 !$ACC PRESENT(wall_flags_0, kh) & 203 !$ACC PRESENT(s) & 204 !$ACC PRESENT(ddzu, ddzw, drho_air, rho_air_zw) & 205 !$ACC PRESENT(surf_def_h(0:2), surf_def_v(0:3)) & 206 !$ACC PRESENT(surf_lsm_h, surf_lsm_v(0:3)) & 207 !$ACC PRESENT(surf_usm_h, surf_usm_v(0:3)) & 208 !$ACC PRESENT(s_flux_def_h_up, s_flux_def_h_down) & 209 !$ACC PRESENT(s_flux_t) & 210 !$ACC PRESENT(s_flux_def_v_north, s_flux_def_v_south) & 211 !$ACC PRESENT(s_flux_def_v_east, s_flux_def_v_west) & 212 !$ACC PRESENT(s_flux_lsm_h_up) & 213 !$ACC PRESENT(s_flux_lsm_v_north, s_flux_lsm_v_south) & 214 !$ACC PRESENT(s_flux_lsm_v_east, s_flux_lsm_v_west) & 215 !$ACC PRESENT(s_flux_usm_h_up) & 216 !$ACC PRESENT(s_flux_usm_v_north, s_flux_usm_v_south) & 217 !$ACC PRESENT(s_flux_usm_v_east, s_flux_usm_v_west) & 218 !$ACC PRESENT(tend) 196 219 DO i = nxl, nxr 197 220 DO j = nys,nyn -
palm/trunk/SOURCE/diffusion_u.f90
r3547 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3547 2018-11-21 13:21:24Z suehring 27 30 ! variables documented 28 31 ! … … 172 175 173 176 177 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) & 178 !$ACC PRIVATE(surf_e, surf_s, flag, kmym, kmyp, kmzm, kmzp) & 179 !$ACC PRIVATE(mask_bottom, mask_north, mask_south, mask_top) & 180 !$ACC PRESENT(wall_flags_0, km) & 181 !$ACC PRESENT(u, v, w) & 182 !$ACC PRESENT(ddzu, ddzw, drho_air, rho_air_zw) & 183 !$ACC PRESENT(surf_def_h(0:2), surf_def_v(0:1)) & 184 !$ACC PRESENT(surf_lsm_h, surf_lsm_v(0:1)) & 185 !$ACC PRESENT(surf_usm_h, surf_usm_v(0:1)) & 186 !$ACC PRESENT(tend) 174 187 DO i = nxlu, nxr 175 188 DO j = nys, nyn -
palm/trunk/SOURCE/diffusion_v.f90
r3547 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3547 2018-11-21 13:21:24Z suehring 27 30 ! variables documented 28 31 ! … … 165 168 REAL(wp) :: mask_top !< flag to mask vertical downward-facing surface 166 169 170 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) & 171 !$ACC PRIVATE(surf_e, surf_s, flag, kmxm, kmxp, kmzm, kmzp) & 172 !$ACC PRIVATE(mask_bottom, mask_east, mask_west, mask_top) & 173 !$ACC PRESENT(wall_flags_0, km) & 174 !$ACC PRESENT(u, v, w) & 175 !$ACC PRESENT(ddzu, ddzw, drho_air, rho_air_zw) & 176 !$ACC PRESENT(surf_def_h(0:2), surf_def_v(2:3)) & 177 !$ACC PRESENT(surf_lsm_h, surf_lsm_v(2:3)) & 178 !$ACC PRESENT(surf_usm_h, surf_usm_v(0:3)) & 179 !$ACC PRESENT(tend) 167 180 DO i = nxl, nxr 168 181 DO j = nysv, nyn -
palm/trunk/SOURCE/diffusion_w.f90
r3547 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3547 2018-11-21 13:21:24Z suehring 27 30 ! variables documented 28 31 ! … … 166 169 167 170 171 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k, l, m) & 172 !$ACC PRIVATE(surf_e, surf_s, flag, kmxm, kmxp, kmym, kmyp) & 173 !$ACC PRIVATE(mask_west, mask_east, mask_south, mask_north) & 174 !$ACC PRESENT(wall_flags_0, km) & 175 !$ACC PRESENT(u, v, w) & 176 !$ACC PRESENT(ddzu, ddzw, rho_air, drho_air_zw) & 177 !$ACC PRESENT(surf_def_v(0:3)) & 178 !$ACC PRESENT(surf_lsm_v(0:3)) & 179 !$ACC PRESENT(surf_usm_v(0:3)) & 180 !$ACC PRESENT(tend) 168 181 DO i = nxl, nxr 169 182 DO j = nys, nyn -
palm/trunk/SOURCE/exchange_horiz.f90
r3241 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3241 2018-09-12 15:02:00Z raasch 27 30 ! unused variables removed 28 31 ! … … 117 120 118 121 122 #ifdef _OPENACC 123 INTEGER(iwp) :: i !< 124 #endif 119 125 INTEGER(iwp) :: nbgp_local !< 120 126 … … 124 130 125 131 CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' ) 132 133 #ifdef _OPENACC 134 !$ACC UPDATE IF_PRESENT & 135 !$ACC HOST(ar(:,:,nxr-nbgp_local+1:nxr)) & 136 !$ACC HOST(ar(:,:,nxl:nxl+nbgp_local-1)) 137 DO i = nxl-nbgp_local, nxr+nbgp_local 138 !$ACC UPDATE IF_PRESENT & 139 !$ACC HOST(ar(:,nyn-nbgp_local+1:nyn,i)) & 140 !$ACC HOST(ar(:,nys:nys+nbgp_local-1,i)) 141 ENDDO 142 #endif 126 143 127 144 #if defined( __parallel ) … … 263 280 264 281 #endif 282 283 #ifdef _OPENACC 284 !$ACC UPDATE IF_PRESENT & 285 !$ACC DEVICE(ar(:,:,nxl-nbgp_local:nxl-1)) & 286 !$ACC DEVICE(ar(:,:,nxr+1:nxr+nbgp_local)) 287 DO i = nxl-nbgp_local, nxr+nbgp_local 288 !$ACC UPDATE IF_PRESENT & 289 !$ACC DEVICE(ar(:,nys-nbgp_local:nys-1,i)) & 290 !$ACC DEVICE(ar(:,nyn+1:nyn+nbgp_local,i)) 291 ENDDO 292 #endif 293 265 294 CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' ) 266 295 -
palm/trunk/SOURCE/fft_xy_mod.f90
r3241 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3241 2018-09-12 15:02:00Z raasch 27 30 ! preprocessor switches for variables that are required on NEC only 28 31 ! … … 156 159 ONLY: fft_method, message_string 157 160 161 USE cuda_fft_interfaces 162 158 163 USE indices, & 159 164 ONLY: nx, ny, nz 160 165 161 #if defined( __fftw ) 166 #if defined( __cuda_fft ) 167 USE ISO_C_BINDING 168 #elif defined( __fftw ) 162 169 USE, INTRINSIC :: ISO_C_BINDING 163 170 #endif … … 210 217 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: trig_yf !< 211 218 219 #elif defined( __cuda_fft ) 220 INTEGER(C_INT), SAVE :: plan_xf !< 221 INTEGER(C_INT), SAVE :: plan_xi !< 222 INTEGER(C_INT), SAVE :: plan_yf !< 223 INTEGER(C_INT), SAVE :: plan_yi !< 224 212 225 #endif 213 226 … … 298 311 ENDIF 299 312 313 #if defined( _OPENACC ) && defined( __cuda_fft ) 314 fft_method = 'system-specific' 315 #endif 316 300 317 IF ( fft_method == 'system-specific' ) THEN 301 318 … … 346 363 CALL ZDFFTM( 0, ny+1, nz1, sqr_dny, work_y, ny+4, work_y, ny+4, & 347 364 trig_yb, worky, 0 ) 365 #elif defined( __cuda_fft ) 366 CALL CUFFTPLAN1D( plan_xf, nx+1, CUFFT_D2Z, (nyn_x-nys_x+1) * (nzt_x-nzb_x+1) ) 367 CALL CUFFTPLAN1D( plan_xi, nx+1, CUFFT_Z2D, (nyn_x-nys_x+1) * (nzt_x-nzb_x+1) ) 368 CALL CUFFTPLAN1D( plan_yf, ny+1, CUFFT_D2Z, (nxr_y-nxl_y+1) * (nzt_y-nzb_y+1) ) 369 CALL CUFFTPLAN1D( plan_yi, ny+1, CUFFT_Z2D, (nxr_y-nxl_y+1) * (nzt_y-nzb_y+1) ) 348 370 #else 349 371 message_string = 'no system-specific fft-call available' … … 425 447 #elif defined( __nec ) 426 448 REAL(wp), DIMENSION(6*(nx+1)) :: work2 !< 449 #elif defined( __cuda_fft ) 450 COMPLEX(dp), DIMENSION(0:(nx+1)/2,nys_x:nyn_x,nzb_x:nzt_x) :: & 451 ar_tmp !< 452 !$ACC DECLARE CREATE(ar_tmp) 427 453 #endif 428 454 … … 726 752 ENDDO 727 753 !$OMP END PARALLEL 754 755 ENDIF 756 757 #elif defined( __cuda_fft ) 758 759 IF ( forward_fft ) THEN 760 761 !$ACC HOST_DATA USE_DEVICE(ar, ar_tmp) 762 CALL CUFFTEXECD2Z( plan_xf, ar, ar_tmp ) 763 !$ACC END HOST_DATA 764 765 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i,j,k) & 766 !$ACC PRESENT(ar, ar_tmp) 767 DO k = nzb_x, nzt_x 768 DO j = nys_x, nyn_x 769 770 DO i = 0, (nx+1)/2 771 ar(i,j,k) = REAL( ar_tmp(i,j,k), KIND=wp ) * dnx 772 ENDDO 773 774 DO i = 1, (nx+1)/2 - 1 775 ar(nx+1-i,j,k) = AIMAG( ar_tmp(i,j,k) ) * dnx 776 ENDDO 777 778 ENDDO 779 ENDDO 780 781 ELSE 782 783 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i,j,k) & 784 !$ACC PRESENT(ar, ar_tmp) 785 DO k = nzb_x, nzt_x 786 DO j = nys_x, nyn_x 787 788 ar_tmp(0,j,k) = CMPLX( ar(0,j,k), 0.0_wp, KIND=wp ) 789 790 DO i = 1, (nx+1)/2 - 1 791 ar_tmp(i,j,k) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k), & 792 KIND=wp ) 793 ENDDO 794 ar_tmp((nx+1)/2,j,k) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp, & 795 KIND=wp ) 796 797 ENDDO 798 ENDDO 799 800 !$ACC HOST_DATA USE_DEVICE(ar, ar_tmp) 801 CALL CUFFTEXECZ2D( plan_xi, ar_tmp, ar ) 802 !$ACC END HOST_DATA 728 803 729 804 ENDIF … … 1001 1076 #elif defined( __nec ) 1002 1077 REAL(wp), DIMENSION(6*(ny+1)) :: work2 !< 1078 #elif defined( __cuda_fft ) 1079 COMPLEX(dp), DIMENSION(0:(ny+1)/2,nxl_y:nxr_y,nzb_y:nzt_y) :: & 1080 ar_tmp !< 1081 !$ACC DECLARE CREATE(ar_tmp) 1003 1082 #endif 1004 1083 … … 1278 1357 1279 1358 ENDIF 1359 #elif defined( __cuda_fft ) 1360 1361 IF ( forward_fft ) THEN 1362 1363 !$ACC HOST_DATA USE_DEVICE(ar, ar_tmp) 1364 CALL CUFFTEXECD2Z( plan_yf, ar, ar_tmp ) 1365 !$ACC END HOST_DATA 1366 1367 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i,j,k) & 1368 !$ACC PRESENT(ar, ar_tmp) 1369 DO k = nzb_y, nzt_y 1370 DO i = nxl_y, nxr_y 1371 1372 DO j = 0, (ny+1)/2 1373 ar(j,i,k) = REAL( ar_tmp(j,i,k), KIND=wp ) * dny 1374 ENDDO 1375 1376 DO j = 1, (ny+1)/2 - 1 1377 ar(ny+1-j,i,k) = AIMAG( ar_tmp(j,i,k) ) * dny 1378 ENDDO 1379 1380 ENDDO 1381 ENDDO 1382 1383 ELSE 1384 1385 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i,j,k) & 1386 !$ACC PRESENT(ar, ar_tmp) 1387 DO k = nzb_y, nzt_y 1388 DO i = nxl_y, nxr_y 1389 1390 ar_tmp(0,i,k) = CMPLX( ar(0,i,k), 0.0_wp, KIND=wp ) 1391 1392 DO j = 1, (ny+1)/2 - 1 1393 ar_tmp(j,i,k) = CMPLX( ar(j,i,k), ar(ny+1-j,i,k), & 1394 KIND=wp ) 1395 ENDDO 1396 ar_tmp((ny+1)/2,i,k) = CMPLX( ar((ny+1)/2,i,k), 0.0_wp, & 1397 KIND=wp ) 1398 1399 ENDDO 1400 ENDDO 1401 1402 !$ACC HOST_DATA USE_DEVICE(ar, ar_tmp) 1403 CALL CUFFTEXECZ2D( plan_yi, ar_tmp, ar ) 1404 !$ACC END HOST_DATA 1405 1406 ENDIF 1407 1280 1408 #endif 1281 1409 -
palm/trunk/SOURCE/poisfft_mod.f90
r3241 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3241 2018-09-12 15:02:00Z raasch 27 30 ! unused variables removed, 28 31 ! declarations of omp_get_thread_num now as omp-directive … … 250 253 REAL(wp), DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar !< 251 254 REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nz) :: ar_inv !< 255 !$ACC DECLARE CREATE(ar_inv) 252 256 253 257 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ar1 !< … … 262 266 IF ( .NOT. poisfft_initialized ) CALL poisfft_init 263 267 268 #ifndef _OPENACC 264 269 ! 265 270 !-- Two-dimensional Fourier Transformation in x- and y-direction. … … 295 300 296 301 ELSEIF ( .NOT. transpose_compute_overlap ) THEN 302 #endif 297 303 298 304 ! … … 366 372 CALL cpu_log( log_point_s(8), 'transpo invers', 'stop' ) 367 373 374 #ifndef _OPENACC 368 375 ELSE 369 376 … … 698 705 699 706 ENDIF 707 #endif 700 708 701 709 CALL cpu_log( log_point_s(3), 'poisfft', 'stop' ) -
palm/trunk/SOURCE/pres.f90
r3347 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3347 2018-10-15 14:21:08Z suehring 27 30 ! Bugfixes in offline nesting. 28 31 ! Add comment. … … 232 235 233 236 CALL cpu_log( log_point(8), 'pres', 'start' ) 237 238 !$ACC DATA COPYOUT(d, tend) & 239 !$ACC COPY(u, v, w, p) & 240 !$ACC COPYIN(rho_air, rho_air_zw, ddzu, ddzw, wall_flags_0) 241 242 !$ACC DATA & 243 !$ACC COPYIN(bc_h(0:1)) & 244 !$ACC COPYIN(bc_h(0)%i(1:bc_h(0)%ns)) & 245 !$ACC COPYIN(bc_h(0)%j(1:bc_h(0)%ns)) & 246 !$ACC COPYIN(bc_h(0)%k(1:bc_h(0)%ns)) & 247 !$ACC COPYIN(bc_h(1)%i(1:bc_h(1)%ns)) & 248 !$ACC COPYIN(bc_h(1)%j(1:bc_h(1)%ns)) & 249 !$ACC COPYIN(bc_h(1)%k(1:bc_h(1)%ns)) 234 250 235 251 … … 442 458 ELSE 443 459 !$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE (i,j,k) 460 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 461 !$ACC PRESENT(d) 444 462 DO i = nxl, nxr 445 463 DO j = nys, nyn … … 490 508 !$OMP PARALLEL PRIVATE (i,j,k) 491 509 !$OMP DO SCHEDULE( STATIC ) 510 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 511 !$ACC PRESENT(u, v, w, rho_air, rho_air_zw, ddzw, wall_flags_0) & 512 !$ACC PRESENT(d) 492 513 DO i = nxl, nxr 493 514 DO j = nys, nyn … … 513 534 !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum) 514 535 !$OMP DO SCHEDULE( STATIC ) 536 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 537 !$ACC REDUCTION(+:threadsum) COPY(threadsum) & 538 !$ACC PRESENT(d) 515 539 DO i = nxl, nxr 516 540 DO j = nys, nyn … … 547 571 !-- z-direction 548 572 !$OMP PARALLEL DO PRIVATE (i,j,k) 573 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 574 !$ACC PRESENT(d, tend) 549 575 DO i = nxl, nxr 550 576 DO j = nys, nyn … … 565 591 !-- Upward facing 566 592 !$OMP PARALLEL DO PRIVATE( i, j, k ) 593 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 594 !$ACC PRESENT(bc_h, tend) 567 595 DO m = 1, bc_h(0)%ns 568 596 i = bc_h(0)%i(m) … … 574 602 !-- Downward facing 575 603 !$OMP PARALLEL DO PRIVATE( i, j, k ) 604 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 605 !$ACC PRESENT(bc_h, tend) 576 606 DO m = 1, bc_h(1)%ns 577 607 i = bc_h(1)%i(m) … … 621 651 !-- Dirichlet 622 652 !$OMP PARALLEL DO PRIVATE (i,j,k) 653 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 654 !$ACC PRESENT(tend) 623 655 DO i = nxlg, nxrg 624 656 DO j = nysg, nyng … … 688 720 !$OMP PARALLEL PRIVATE (i,j,k) 689 721 !$OMP DO 722 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 723 !$ACC PRESENT(p, tend) 690 724 DO i = nxl-1, nxr+1 691 725 DO j = nys-1, nyn+1 … … 701 735 !$OMP PARALLEL PRIVATE (i,j,k) 702 736 !$OMP DO 737 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 738 !$ACC PRESENT(p, tend) 703 739 DO i = nxl-1, nxr+1 704 740 DO j = nys-1, nyn+1 … … 733 769 !$OMP PARALLEL PRIVATE (i,j,k) 734 770 !$OMP DO 771 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k) & 772 !$ACC PRESENT(u, v, w, tend, ddzu, wall_flags_0) 735 773 DO i = nxl, nxr 736 774 DO j = nys, nyn … … 900 938 #else 901 939 !$OMP DO SCHEDULE( STATIC ) 940 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 941 !$ACC PRESENT(u, v, w, rho_air, rho_air_zw, ddzw, wall_flags_0) & 942 !$ACC PRESENT(d) 902 943 DO i = nxl, nxr 903 944 DO j = nys, nyn … … 916 957 !-- Compute possible PE-sum of divergences for flow_statistics 917 958 !$OMP DO SCHEDULE( STATIC ) 959 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 960 !$ACC REDUCTION(+:threadsum) COPY(threadsum) & 961 !$ACC PRESENT(d) 918 962 DO i = nxl, nxr 919 963 DO j = nys, nyn … … 939 983 CALL cpu_log( log_point(8), 'pres', 'stop' ) 940 984 985 !$ACC END DATA 986 !$ACC END DATA 941 987 942 988 END SUBROUTINE pres -
palm/trunk/SOURCE/prognostic_equations.f90
r3589 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3589 2018-11-30 15:09:51Z suehring 27 30 ! Move the control parameter "salsa" from salsa_mod to control_parameters 28 31 ! (M. Kurppa) … … 1566 1569 CALL cpu_log( log_point(5), 'u-equation', 'start' ) 1567 1570 1571 !$ACC KERNELS PRESENT(tend) 1568 1572 tend = 0.0_wp 1573 !$ACC END KERNELS 1569 1574 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1570 1575 IF ( ws_scheme_mom ) THEN … … 1614 1619 ! 1615 1620 !-- Prognostic equation for u-velocity component 1621 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1622 !$ACC PRESENT(u, tend, tu_m, u_init, rdf, wall_flags_0) & 1623 !$ACC PRESENT(tsc(2:5)) & 1624 !$ACC PRESENT(u_p) 1616 1625 DO i = nxlu, nxr 1617 1626 DO j = nys, nyn … … 1640 1649 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1641 1650 IF ( intermediate_timestep_count == 1 ) THEN 1651 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1652 !$ACC PRESENT(tend, tu_m) 1642 1653 DO i = nxlu, nxr 1643 1654 DO j = nys, nyn … … 1649 1660 ELSEIF ( intermediate_timestep_count < & 1650 1661 intermediate_timestep_count_max ) THEN 1662 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1663 !$ACC PRESENT(tend, tu_m) 1651 1664 DO i = nxlu, nxr 1652 1665 DO j = nys, nyn … … 1666 1679 CALL cpu_log( log_point(6), 'v-equation', 'start' ) 1667 1680 1681 !$ACC KERNELS PRESENT(tend) 1668 1682 tend = 0.0_wp 1683 !$ACC END KERNELS 1669 1684 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1670 1685 IF ( ws_scheme_mom ) THEN … … 1711 1726 ! 1712 1727 !-- Prognostic equation for v-velocity component 1728 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1729 !$ACC PRESENT(v, tend, tv_m, v_init, rdf, wall_flags_0) & 1730 !$ACC PRESENT(tsc(2:5)) & 1731 !$ACC PRESENT(v_p) 1713 1732 DO i = nxl, nxr 1714 1733 DO j = nysv, nyn … … 1737 1756 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1738 1757 IF ( intermediate_timestep_count == 1 ) THEN 1758 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1759 !$ACC PRESENT(tend, tv_m) 1739 1760 DO i = nxl, nxr 1740 1761 DO j = nysv, nyn … … 1746 1767 ELSEIF ( intermediate_timestep_count < & 1747 1768 intermediate_timestep_count_max ) THEN 1769 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1770 !$ACC PRESENT(tend, tv_m) 1748 1771 DO i = nxl, nxr 1749 1772 DO j = nysv, nyn … … 1763 1786 CALL cpu_log( log_point(7), 'w-equation', 'start' ) 1764 1787 1788 !$ACC KERNELS PRESENT(tend) 1765 1789 tend = 0.0_wp 1790 !$ACC END KERNELS 1766 1791 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1767 1792 IF ( ws_scheme_mom ) THEN … … 1804 1829 ! 1805 1830 !-- Prognostic equation for w-velocity component 1831 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1832 !$ACC PRESENT(w, tend, tw_m, v_init, rdf, wall_flags_0) & 1833 !$ACC PRESENT(tsc(2:5)) & 1834 !$ACC PRESENT(w_p) 1806 1835 DO i = nxl, nxr 1807 1836 DO j = nys, nyn … … 1821 1850 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1822 1851 IF ( intermediate_timestep_count == 1 ) THEN 1852 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1853 !$ACC PRESENT(tend, tw_m) 1823 1854 DO i = nxl, nxr 1824 1855 DO j = nys, nyn … … 1830 1861 ELSEIF ( intermediate_timestep_count < & 1831 1862 intermediate_timestep_count_max ) THEN 1863 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1864 !$ACC PRESENT(tend, tw_m) 1832 1865 DO i = nxl, nxr 1833 1866 DO j = nys, nyn … … 1868 1901 !-- pt-tendency terms with no communication 1869 1902 IF ( scalar_advec /= 'bc-scheme' ) THEN 1903 !$ACC KERNELS PRESENT(tend) 1870 1904 tend = 0.0_wp 1905 !$ACC END KERNELS 1871 1906 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1872 1907 IF ( ws_scheme_sca ) THEN … … 1926 1961 ! 1927 1962 !-- Prognostic equation for potential temperature 1963 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1964 !$ACC PRESENT(pt, tend, tpt_m, wall_flags_0) & 1965 !$ACC PRESENT(pt_init, rdf_sc, ptdf_x, ptdf_y) & 1966 !$ACC PRESENT(tsc(3:5)) & 1967 !$ACC PRESENT(pt_p) 1928 1968 DO i = nxl, nxr 1929 1969 DO j = nys, nyn … … 1945 1985 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1946 1986 IF ( intermediate_timestep_count == 1 ) THEN 1987 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1988 !$ACC PRESENT(tend, tpt_m) 1947 1989 DO i = nxl, nxr 1948 1990 DO j = nys, nyn … … 1954 1996 ELSEIF ( intermediate_timestep_count < & 1955 1997 intermediate_timestep_count_max ) THEN 1998 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 1999 !$ACC PRESENT(tend, tpt_m) 1956 2000 DO i = nxl, nxr 1957 2001 DO j = nys, nyn -
palm/trunk/SOURCE/surface_layer_fluxes_mod.f90
r3597 r3634 26 26 ! ----------------- 27 27 ! $Id$ 28 ! OpenACC port for SPEC 29 ! 30 ! 3597 2018-12-04 08:40:18Z maronga 28 31 ! Added routine for calculating near surface air potential temperature (moved 29 32 ! from urban_surface_mod) … … 1009 1012 ibit = MERGE( 1, 0, .NOT. downward ) 1010 1013 1014 !$ACC PARALLEL LOOP PRIVATE(i, j, k, w_lfc) & 1015 !$ACC PRESENT(surf, u, v) 1011 1016 DO m = 1, surf%ns 1012 1017 … … 1297 1302 ELSE 1298 1303 !$OMP PARALLEL DO PRIVATE( k, z_mo ) 1304 !$ACC PARALLEL LOOP PRIVATE(k, z_mo) & 1305 !$ACC PRESENT(surf, drho_air_zw) 1299 1306 DO m = 1, surf%ns 1300 1307 … … 1319 1326 IF ( TRIM( most_method ) == 'newton' ) THEN 1320 1327 1328 !$ACC PARALLEL LOOP PRIVATE(i, j, z_mo) & 1329 !$ACC PRIVATE(ol_old, ol_m, ol_l, ol_u, f, f_d_ol) & 1330 !$ACC PRESENT(surf) 1321 1331 DO m = 1, surf%ns 1322 1332 … … 1575 1585 IF ( .NOT. downward ) THEN 1576 1586 !$OMP PARALLEL DO PRIVATE( z_mo ) 1587 !$ACC PARALLEL LOOP PRIVATE(z_mo) & 1588 !$ACC PRESENT(surf) 1577 1589 DO m = 1, surf%ns 1578 1590 … … 1591 1603 ELSE 1592 1604 !$OMP PARALLEL DO PRIVATE( z_mo ) 1605 !$ACC PARALLEL LOOP PRIVATE(z_mo) & 1606 !$ACC PRESENT(surf) 1593 1607 DO m = 1, surf%ns 1594 1608 … … 1605 1619 ELSE 1606 1620 !$OMP PARALLEL DO PRIVATE( z_mo ) 1621 !$ACC PARALLEL LOOP PRIVATE(z_mo) & 1622 !$ACC PRESENT(surf) 1607 1623 DO m = 1, surf%ns 1608 1624 z_mo = surf%z_mo(m) … … 1624 1640 1625 1641 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1642 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 1643 !$ACC PRESENT(surf, pt) 1626 1644 DO m = 1, surf%ns 1627 1645 … … 1630 1648 k = surf%k(m) 1631 1649 1650 #ifndef _OPENACC 1632 1651 IF ( bulk_cloud_model ) THEN 1633 1652 surf%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i) … … 1637 1656 surf%qv1(m) = q(k,j,i) 1638 1657 ELSE 1658 #endif 1639 1659 surf%pt1(m) = pt(k,j,i) 1660 #ifndef _OPENACC 1640 1661 IF ( humidity ) THEN 1641 1662 surf%qv1(m) = q(k,j,i) 1642 1663 ELSE 1664 #endif 1643 1665 surf%qv1(m) = 0.0_wp 1666 #ifndef _OPENACC 1644 1667 ENDIF 1645 1668 ENDIF … … 1648 1671 surf%vpt1(m) = pt(k,j,i) * ( 1.0_wp + 0.61_wp * q(k,j,i) ) 1649 1672 ENDIF 1673 #endif 1650 1674 1651 1675 ENDDO … … 1658 1682 !-- ( only for upward-facing surfs ) 1659 1683 SUBROUTINE calc_pt_surface 1684 1685 IMPLICIT NONE 1686 1687 INTEGER(iwp) :: k_off !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls) 1688 INTEGER(iwp) :: m !< loop variable over all horizontal surf elements 1689 1690 k_off = surf%koff 1691 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1692 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 1693 !$ACC PRESENT(surf, pt) 1694 DO m = 1, surf%ns 1695 1696 i = surf%i(m) 1697 j = surf%j(m) 1698 k = surf%k(m) 1699 1700 surf%pt_surface(m) = pt(k+k_off,j,i) 1701 1702 ENDDO 1703 1704 END SUBROUTINE calc_pt_surface 1705 1706 ! 1707 !-- Set mixing ratio at surface grid level. ( Only for upward-facing surfs. ) 1708 SUBROUTINE calc_q_surface 1709 1710 IMPLICIT NONE 1711 1712 INTEGER(iwp) :: k_off !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls) 1713 INTEGER(iwp) :: m !< loop variable over all horizontal surf elements 1714 1715 k_off = surf%koff 1716 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1717 DO m = 1, surf%ns 1718 1719 i = surf%i(m) 1720 j = surf%j(m) 1721 k = surf%k(m) 1722 1723 surf%q_surface(m) = q(k+k_off,j,i) 1724 1725 ENDDO 1726 1727 END SUBROUTINE calc_q_surface 1728 1729 ! 1730 !-- Set virtual potential temperature at surface grid level. 1731 !-- ( only for upward-facing surfs ) 1732 SUBROUTINE calc_vpt_surface 1660 1733 1661 1734 IMPLICIT NONE … … 1672 1745 k = surf%k(m) 1673 1746 1674 surf%pt_surface(m) = pt(k+k_off,j,i)1675 1676 ENDDO1677 1678 END SUBROUTINE calc_pt_surface1679 1680 !1681 !-- Set mixing ratio at surface grid level. ( Only for upward-facing surfs. )1682 SUBROUTINE calc_q_surface1683 1684 IMPLICIT NONE1685 1686 INTEGER(iwp) :: k_off !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls)1687 INTEGER(iwp) :: m !< loop variable over all horizontal surf elements1688 1689 k_off = surf%koff1690 !$OMP PARALLEL DO PRIVATE( i, j, k )1691 DO m = 1, surf%ns1692 1693 i = surf%i(m)1694 j = surf%j(m)1695 k = surf%k(m)1696 1697 surf%q_surface(m) = q(k+k_off,j,i)1698 1699 ENDDO1700 1701 END SUBROUTINE calc_q_surface1702 1703 !1704 !-- Set virtual potential temperature at surface grid level.1705 !-- ( only for upward-facing surfs )1706 SUBROUTINE calc_vpt_surface1707 1708 IMPLICIT NONE1709 1710 INTEGER(iwp) :: k_off !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls)1711 INTEGER(iwp) :: m !< loop variable over all horizontal surf elements1712 1713 k_off = surf%koff1714 !$OMP PARALLEL DO PRIVATE( i, j, k )1715 DO m = 1, surf%ns1716 1717 i = surf%i(m)1718 j = surf%j(m)1719 k = surf%k(m)1720 1721 1747 surf%vpt_surface(m) = vpt(k+k_off,j,i) 1722 1748 … … 1741 1767 1742 1768 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1769 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 1770 !$ACC PRESENT(surf, drho_air_zw) 1743 1771 DO m = 1, surf%ns 1744 1772 … … 2039 2067 IF ( .NOT. downward ) THEN 2040 2068 !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo ) 2069 !$ACC PARALLEL LOOP PRIVATE(i, j, k, z_mo) & 2070 !$ACC PRESENT(surf, u, rho_air_zw) 2041 2071 DO m = 1, surf%ns 2042 2072 … … 2086 2116 IF ( .NOT. downward ) THEN 2087 2117 !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo ) 2118 !$ACC PARALLEL LOOP PRIVATE(i, j, k, z_mo) & 2119 !$ACC PRESENT(surf, v, rho_air_zw) 2088 2120 DO m = 1, surf%ns 2089 2121 i = surf%i(m) … … 2392 2424 !-- Integrated stability function for momentum 2393 2425 FUNCTION psi_m( zeta ) 2426 !$ACC ROUTINE SEQ 2394 2427 2395 2428 USE kinds … … 2429 2462 !-- Integrated stability function for heat and moisture 2430 2463 FUNCTION psi_h( zeta ) 2464 !$ACC ROUTINE SEQ 2431 2465 2432 2466 USE kinds … … 2469 2503 !------------------------------------------------------------------------------! 2470 2504 FUNCTION phi_m( zeta ) 2505 !$ACC ROUTINE SEQ 2471 2506 2472 2507 IMPLICIT NONE -
palm/trunk/SOURCE/surface_mod.f90
r3597 r3634 26 26 ! ----------------- 27 27 ! $Id$ 28 ! OpenACC port for SPEC 29 ! 30 ! 3597 2018-12-04 08:40:18Z maronga 28 31 ! Added pt_2m and renamed t_surf_10cm to pt_10cm. Removed some _eb variables as 29 32 ! they are no longer used. … … 608 611 END INTERFACE init_surface_arrays 609 612 613 INTERFACE enter_surface_arrays 614 MODULE PROCEDURE enter_surface_arrays 615 END INTERFACE 616 617 INTERFACE exit_surface_arrays 618 MODULE PROCEDURE exit_surface_arrays 619 END INTERFACE 620 610 621 INTERFACE surface_rrd_local 611 622 MODULE PROCEDURE surface_rrd_local … … 634 645 !-- Public subroutines and functions 635 646 PUBLIC get_topography_top_index, get_topography_top_index_ji, init_bc, & 636 init_surfaces, init_surface_arrays, surface_rrd_local, & 637 surface_restore_elements, surface_wrd_local, surface_last_actions 647 init_surfaces, init_surface_arrays, enter_surface_arrays, & 648 exit_surface_arrays, surface_rrd_local, surface_restore_elements, & 649 surface_wrd_local, surface_last_actions 638 650 639 651 … … 1084 1096 1085 1097 END SUBROUTINE init_surface_arrays 1098 1099 1100 !------------------------------------------------------------------------------! 1101 ! Description: 1102 ! ------------ 1103 !> Enter horizontal and vertical surfaces. 1104 !------------------------------------------------------------------------------! 1105 SUBROUTINE enter_surface_arrays 1106 1107 IMPLICIT NONE 1108 1109 INTEGER(iwp) :: l !< 1110 1111 !$ACC ENTER DATA & 1112 !$ACC COPYIN(surf_def_h(0:2)) & 1113 !$ACC COPYIN(surf_def_v(0:3)) & 1114 !$ACC COPYIN(surf_lsm_h) & 1115 !$ACC COPYIN(surf_lsm_v(0:3)) & 1116 !$ACC COPYIN(surf_usm_h) & 1117 !$ACC COPYIN(surf_usm_v(0:3)) 1118 1119 ! Copy data in surf_def_h(0:2) 1120 DO l = 0, 1 1121 CALL enter_surface_attributes_h(surf_def_h(l)) 1122 ENDDO 1123 CALL enter_surface_attributes_h_top(surf_def_h(2)) 1124 ! Copy data in surf_def_v(0:3) 1125 DO l = 0, 3 1126 CALL enter_surface_attributes_v(surf_def_v(l)) 1127 ENDDO 1128 ! Copy data in surf_lsm_h 1129 CALL enter_surface_attributes_h(surf_lsm_h) 1130 ! Copy data in surf_lsm_v(0:3) 1131 DO l = 0, 3 1132 CALL enter_surface_attributes_v(surf_lsm_v(l)) 1133 ENDDO 1134 ! Copy data in surf_usm_h 1135 CALL enter_surface_attributes_h(surf_usm_h) 1136 ! Copy data in surf_usm_v(0:3) 1137 DO l = 0, 3 1138 CALL enter_surface_attributes_v(surf_usm_v(l)) 1139 ENDDO 1140 1141 END SUBROUTINE enter_surface_arrays 1142 1143 1144 !------------------------------------------------------------------------------! 1145 ! Description: 1146 ! ------------ 1147 !> Exit horizontal and vertical surfaces. 1148 !------------------------------------------------------------------------------! 1149 SUBROUTINE exit_surface_arrays 1150 1151 IMPLICIT NONE 1152 1153 INTEGER(iwp) :: l !< 1154 1155 ! Delete data in surf_def_h(0:2) 1156 DO l = 0, 1 1157 CALL exit_surface_attributes_h(surf_def_h(l)) 1158 ENDDO 1159 CALL exit_surface_attributes_h(surf_def_h(2)) 1160 ! Delete data in surf_def_v(0:3) 1161 DO l = 0, 3 1162 CALL exit_surface_attributes_v(surf_def_v(l)) 1163 ENDDO 1164 ! Delete data in surf_lsm_h 1165 CALL exit_surface_attributes_h(surf_lsm_h) 1166 ! Delete data in surf_lsm_v(0:3) 1167 DO l = 0, 3 1168 CALL exit_surface_attributes_v(surf_lsm_v(l)) 1169 ENDDO 1170 ! Delete data in surf_usm_h 1171 CALL exit_surface_attributes_h(surf_usm_h) 1172 ! Delete data in surf_usm_v(0:3) 1173 DO l = 0, 3 1174 CALL exit_surface_attributes_v(surf_usm_v(l)) 1175 ENDDO 1176 1177 !$ACC EXIT DATA & 1178 !$ACC DELETE(surf_def_h(0:2)) & 1179 !$ACC DELETE(surf_def_v(0:3)) & 1180 !$ACC DELETE(surf_lsm_h) & 1181 !$ACC DELETE(surf_lsm_v(0:3)) & 1182 !$ACC DELETE(surf_usm_h) & 1183 !$ACC DELETE(surf_usm_v(0:3)) 1184 1185 END SUBROUTINE exit_surface_arrays 1086 1186 1087 1187 … … 1328 1428 ! Description: 1329 1429 ! ------------ 1430 !> Exit memory for upward and downward-facing horizontal surface types, 1431 !> except for top fluxes. 1432 !------------------------------------------------------------------------------! 1433 SUBROUTINE exit_surface_attributes_h( surfaces ) 1434 1435 IMPLICIT NONE 1436 1437 TYPE(surf_type) :: surfaces !< respective surface type 1438 1439 !$ACC EXIT DATA & 1440 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1441 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1442 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1443 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1444 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1445 !$ACC DELETE(surfaces%z_mo(1:surfaces%ns)) & 1446 !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) & 1447 !$ACC DELETE(surfaces%z0(1:surfaces%ns)) & 1448 !$ACC COPYOUT(surfaces%us(1:surfaces%ns)) & 1449 !$ACC COPYOUT(surfaces%ol(1:surfaces%ns)) & 1450 !$ACC DELETE(surfaces%rib(1:surfaces%ns)) & 1451 !$ACC COPYOUT(surfaces%usws(1:surfaces%ns)) & 1452 !$ACC COPYOUT(surfaces%vsws(1:surfaces%ns)) & 1453 !$ACC COPYOUT(surfaces%ts(1:surfaces%ns)) & 1454 !$ACC COPYOUT(surfaces%shf(1:surfaces%ns)) & 1455 !$ACC DELETE(surfaces%pt_surface(1:surfaces%ns)) & 1456 !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) & 1457 !$ACC DELETE(surfaces%qv1(1:surfaces%ns)) 1458 1459 IF ( .NOT. constant_diffusion ) THEN 1460 !$ACC EXIT DATA & 1461 !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) & 1462 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1463 ENDIF 1464 1465 END SUBROUTINE exit_surface_attributes_h 1466 1467 1468 !------------------------------------------------------------------------------! 1469 ! Description: 1470 ! ------------ 1471 !> Enter memory for upward and downward-facing horizontal surface types, 1472 !> except for top fluxes. 1473 !------------------------------------------------------------------------------! 1474 SUBROUTINE enter_surface_attributes_h( surfaces ) 1475 1476 IMPLICIT NONE 1477 1478 TYPE(surf_type) :: surfaces !< respective surface type 1479 1480 !$ACC ENTER DATA & 1481 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1482 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1483 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1484 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1485 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1486 !$ACC COPYIN(surfaces%z_mo(1:surfaces%ns)) & 1487 !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) & 1488 !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) & 1489 !$ACC COPYIN(surfaces%us(1:surfaces%ns)) & 1490 !$ACC COPYIN(surfaces%ol(1:surfaces%ns)) & 1491 !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) & 1492 !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) & 1493 !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) & 1494 !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) & 1495 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) & 1496 !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) & 1497 !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) & 1498 !$ACC COPYIN(surfaces%pt_surface(1:surfaces%ns)) 1499 1500 IF ( .NOT. constant_diffusion ) THEN 1501 !$ACC ENTER DATA & 1502 !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) & 1503 !$ACC COPYIN(surfaces%v_0(1:surfaces%ns)) 1504 ENDIF 1505 1506 END SUBROUTINE enter_surface_attributes_h 1507 1508 1509 !------------------------------------------------------------------------------! 1510 ! Description: 1511 ! ------------ 1330 1512 !> Deallocating memory for model-top fluxes 1331 1513 !------------------------------------------------------------------------------! … … 1460 1642 1461 1643 END SUBROUTINE allocate_surface_attributes_h_top 1644 1645 1646 !------------------------------------------------------------------------------! 1647 ! Description: 1648 ! ------------ 1649 !> Exit memory for model-top fluxes. 1650 !------------------------------------------------------------------------------! 1651 SUBROUTINE exit_surface_attributes_h_top( surfaces ) 1652 1653 IMPLICIT NONE 1654 1655 TYPE(surf_type) :: surfaces !< respective surface type 1656 1657 !$ACC EXIT DATA & 1658 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1659 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1660 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1661 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1662 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1663 !$ACC DELETE(surfaces%usws(1:surfaces%ns)) & 1664 !$ACC DELETE(surfaces%vsws(1:surfaces%ns)) & 1665 !$ACC DELETE(surfaces%shf(1:surfaces%ns)) 1666 1667 IF ( .NOT. constant_diffusion ) THEN 1668 !$ACC EXIT DATA & 1669 !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) & 1670 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1671 ENDIF 1672 1673 END SUBROUTINE exit_surface_attributes_h_top 1674 1675 1676 !------------------------------------------------------------------------------! 1677 ! Description: 1678 ! ------------ 1679 !> Enter memory for model-top fluxes. 1680 !------------------------------------------------------------------------------! 1681 SUBROUTINE enter_surface_attributes_h_top( surfaces ) 1682 1683 IMPLICIT NONE 1684 1685 TYPE(surf_type) :: surfaces !< respective surface type 1686 1687 !$ACC ENTER DATA & 1688 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1689 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1690 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1691 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1692 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1693 !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) & 1694 !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) & 1695 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) 1696 1697 IF ( .NOT. constant_diffusion ) THEN 1698 !$ACC ENTER DATA & 1699 !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) & 1700 !$ACC COPYIN(surfaces%v_0(1:surfaces%ns)) 1701 ENDIF 1702 1703 END SUBROUTINE enter_surface_attributes_h_top 1462 1704 1463 1705 … … 1703 1945 1704 1946 END SUBROUTINE allocate_surface_attributes_v 1947 1948 1949 !------------------------------------------------------------------------------! 1950 ! Description: 1951 ! ------------ 1952 !> Exit memory for vertical surface types. 1953 !------------------------------------------------------------------------------! 1954 SUBROUTINE exit_surface_attributes_v( surfaces ) 1955 1956 IMPLICIT NONE 1957 1958 TYPE(surf_type) :: surfaces !< respective surface type 1959 1960 !$ACC EXIT DATA & 1961 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1962 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1963 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1964 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1965 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1966 !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) & 1967 !$ACC DELETE(surfaces%z0(1:surfaces%ns)) & 1968 !$ACC DELETE(surfaces%rib(1:surfaces%ns)) & 1969 !$ACC DELETE(surfaces%mom_flux_uv(1:surfaces%ns)) & 1970 !$ACC DELETE(surfaces%mom_flux_w(1:surfaces%ns)) & 1971 !$ACC DELETE(surfaces%mom_flux_tke(0:1,1:surfaces%ns)) & 1972 !$ACC DELETE(surfaces%ts(1:surfaces%ns)) & 1973 !$ACC DELETE(surfaces%shf(1:surfaces%ns)) & 1974 !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) & 1975 !$ACC DELETE(surfaces%qv1(1:surfaces%ns)) 1976 1977 END SUBROUTINE exit_surface_attributes_v 1978 1979 1980 !------------------------------------------------------------------------------! 1981 ! Description: 1982 ! ------------ 1983 !> Enter memory for vertical surface types. 1984 !------------------------------------------------------------------------------! 1985 SUBROUTINE enter_surface_attributes_v( surfaces ) 1986 1987 IMPLICIT NONE 1988 1989 TYPE(surf_type) :: surfaces !< respective surface type 1990 1991 !$ACC ENTER DATA & 1992 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1993 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1994 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1995 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1996 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1997 !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) & 1998 !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) & 1999 !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) & 2000 !$ACC COPYIN(surfaces%mom_flux_uv(1:surfaces%ns)) & 2001 !$ACC COPYIN(surfaces%mom_flux_w(1:surfaces%ns)) & 2002 !$ACC COPYIN(surfaces%mom_flux_tke(0:1,1:surfaces%ns)) & 2003 !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) & 2004 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) & 2005 !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) & 2006 !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) 2007 2008 END SUBROUTINE enter_surface_attributes_v 1705 2009 1706 2010 -
palm/trunk/SOURCE/time_integration.f90
r3597 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3597 2018-12-04 08:40:18Z maronga 27 30 ! Removed call to calculation of near air (10 cm) potential temperature (now in 28 31 ! surface layer fluxes) … … 421 424 422 425 USE arrays_3d, & 423 ONLY: diss, diss_p, dzu, e, e_p, nc, nc_p, nr, nr_p, prho, pt, pt_p, pt_init, & 424 q_init, q, qc, qc_p, ql, ql_c, ql_v, ql_vp, qr, qr_p, q_p, & 425 ref_state, rho_ocean, s, s_p, sa_p, tend, u, u_p, v, vpt, & 426 v_p, w, w_p 426 ONLY: d, diss, diss_p, ddzu, dd2zu, ddzw, drho_air, drho_air_zw, dzu, & 427 dzw, e, e_p, kh, km, nc, nc_p, nr, nr_p, p, prho, pt, pt_p, & 428 pt_init, ptdf_x, ptdf_y, q_init, q, qc, qc_p, ql, ql_c, ql_v, & 429 ql_vp, qr, qr_p, q_p, rdf, rdf_sc, ref_state, rho_air, & 430 rho_air_zw, rho_ocean, s, s_p, sa_p, te_m, tend, tpt_m, tu_m, & 431 tv_m, tw_m, u, ug, u_init, u_p, u_stokes_zu, v, vg, v_init, vpt,& 432 v_p, v_stokes_zu, w, w_p, zu 427 433 428 434 USE biometeorology_mod, & … … 479 485 time_dopr_listing, time_dopts, time_dosp, time_dosp_av, & 480 486 time_dots, time_do_av, time_do_sla, time_disturb, time_dvrp, & 481 time_run_control, time_since_reference_point, 487 time_run_control, time_since_reference_point, tsc, & 482 488 turbulent_inflow, turbulent_outflow, urban_surface, & 483 489 use_initial_profile_as_reference, & … … 499 505 500 506 USE indices, & 501 ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, nzb, nzt 507 ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 508 nz, nzb_max, advc_flags_1, advc_flags_2, wall_flags_0 502 509 503 510 USE indoor_model_mod, & … … 556 563 salsa_boundary_conds, salsa_gas, salsa_gases_from_chem, & 557 564 skip_time_do_salsa 565 566 USE salsa_util_mod, & 567 ONLY: sums_salsa_ws_l 558 568 559 569 USE spectra_mod, & … … 562 572 563 573 USE statistics, & 564 ONLY: flow_statistics_called, hom, pr_palm, sums_ls_l 574 ONLY: flow_statistics_called, hom, pr_palm, sums_ls_l, & 575 rmask, statistic_regions, weight_substep, sums_l_l, & 576 sums_us2_ws_l, sums_wsus_ws_l, sums_vs2_ws_l, sums_wsvs_ws_l, & 577 sums_ws2_ws_l, sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l,& 578 sums_wsqcs_ws_l, sums_wsqrs_ws_l, sums_wsncs_ws_l, & 579 sums_wsnrs_ws_l, sums_wsss_ws_l 565 580 566 581 USE surface_layer_fluxes_mod, & … … 568 583 569 584 USE surface_mod, & 570 ONLY: surf_def_h, surf_lsm_h, surf_usm_h 585 ONLY: bc_h, surf_def_h, surf_lsm_h, surf_usm_h, & 586 enter_surface_arrays, exit_surface_arrays 571 587 572 588 USE surface_output_mod, & … … 623 639 REAL(wp) :: time_since_reference_point_save !< original value of 624 640 !< time_since_reference_point 641 642 643 ! Copy data from arrays_3d 644 !$ACC DATA & 645 !$ACC COPY(d(nzb+1:nzt,nys:nyn,nxl:nxr)) & 646 !$ACC COPY(e(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 647 !$ACC COPY(u(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 648 !$ACC COPY(v(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 649 !$ACC COPY(w(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 650 !$ACC COPY(kh(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 651 !$ACC COPY(km(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 652 !$ACC COPY(p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 653 !$ACC COPY(pt(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) 654 655 !$ACC DATA & 656 !$ACC COPY(e_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 657 !$ACC COPY(u_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 658 !$ACC COPY(v_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 659 !$ACC COPY(w_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 660 !$ACC COPY(pt_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 661 !$ACC COPY(tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 662 !$ACC COPY(te_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 663 !$ACC COPY(tu_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 664 !$ACC COPY(tv_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 665 !$ACC COPY(tw_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 666 !$ACC COPY(tpt_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) 667 668 !$ACC DATA & 669 !$ACC COPYIN(rho_air(nzb:nzt+1), drho_air(nzb:nzt+1)) & 670 !$ACC COPYIN(rho_air_zw(nzb:nzt+1), drho_air_zw(nzb:nzt+1)) & 671 !$ACC COPYIN(zu(nzb:nzt+1)) & 672 !$ACC COPYIN(dzu(1:nzt+1), dzw(1:nzt+1)) & 673 !$ACC COPYIN(ddzu(1:nzt+1), dd2zu(1:nzt)) & 674 !$ACC COPYIN(ddzw(1:nzt+1)) & 675 !$ACC COPYIN(rdf(nzb+1:nzt), rdf_sc(nzb+1:nzt)) & 676 !$ACC COPYIN(ptdf_x(nxlg:nxrg), ptdf_y(nysg:nyng)) & 677 !$ACC COPYIN(ref_state(0:nz+1)) & 678 !$ACC COPYIN(u_init(0:nz+1), v_init(0:nz+1)) & 679 !$ACC COPYIN(u_stokes_zu(nzb:nzt+1), v_stokes_zu(nzb:nzt+1)) & 680 !$ACC COPYIN(pt_init(0:nz+1)) & 681 !$ACC COPYIN(ug(0:nz+1), vg(0:nz+1)) 682 683 ! Copy data from control_parameters 684 !$ACC DATA & 685 !$ACC COPYIN(tsc(1:5)) 686 687 ! Copy data from indices 688 !$ACC DATA & 689 !$ACC COPYIN(advc_flags_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 690 !$ACC COPYIN(advc_flags_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 691 !$ACC COPYIN(wall_flags_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) 692 693 ! Copy data from surface_mod 694 !$ACC DATA & 695 !$ACC COPYIN(bc_h(0:1)) & 696 !$ACC COPYIN(bc_h(0)%i(1:bc_h(0)%ns)) & 697 !$ACC COPYIN(bc_h(0)%j(1:bc_h(0)%ns)) & 698 !$ACC COPYIN(bc_h(0)%k(1:bc_h(0)%ns)) & 699 !$ACC COPYIN(bc_h(1)%i(1:bc_h(1)%ns)) & 700 !$ACC COPYIN(bc_h(1)%j(1:bc_h(1)%ns)) & 701 !$ACC COPYIN(bc_h(1)%k(1:bc_h(1)%ns)) 702 703 ! Copy data from statistics 704 !$ACC DATA & 705 !$ACC COPYIN(hom(nzb+1:nzb_max,1,1:3,0)) & 706 !$ACC COPYIN(rmask(nysg:nyng,nxlg:nxrg,0:statistic_regions)) & 707 !$ACC COPYIN(weight_substep(1:intermediate_timestep_count_max)) & 708 !$ACC COPY(sums_l_l(nzb:nzt+1,0:statistic_regions,0)) & 709 !$ACC COPY(sums_us2_ws_l(nzb:nzt+1,0)) & 710 !$ACC COPY(sums_wsus_ws_l(nzb:nzt+1,0)) & 711 !$ACC COPY(sums_vs2_ws_l(nzb:nzt+1,0)) & 712 !$ACC COPY(sums_wsvs_ws_l(nzb:nzt+1,0)) & 713 !$ACC COPY(sums_ws2_ws_l(nzb:nzt+1,0)) & 714 !$ACC COPY(sums_wspts_ws_l(nzb:nzt+1,0)) & 715 !$ACC COPY(sums_wssas_ws_l(nzb:nzt+1,0)) & 716 !$ACC COPY(sums_wsqs_ws_l(nzb:nzt+1,0)) & 717 !$ACC COPY(sums_wsqcs_ws_l(nzb:nzt+1,0)) & 718 !$ACC COPY(sums_wsqrs_ws_l(nzb:nzt+1,0)) & 719 !$ACC COPY(sums_wsncs_ws_l(nzb:nzt+1,0)) & 720 !$ACC COPY(sums_wsnrs_ws_l(nzb:nzt+1,0)) & 721 !$ACC COPY(sums_wsss_ws_l(nzb:nzt+1,0)) & 722 !$ACC COPY(sums_salsa_ws_l(nzb:nzt+1,0)) 625 723 626 724 ! … … 739 837 ENDIF 740 838 839 #ifdef _OPENACC 840 CALL enter_surface_arrays 841 #endif 842 741 843 ! 742 844 !-- Start of intermediate step loop … … 1252 1354 1253 1355 ENDDO ! Intermediate step loop 1356 1357 ! 1358 !-- Will be used at some point by flow_statistics. 1359 !$ACC UPDATE HOST(e, u, v, w, pt) & 1360 !$ACC HOST(kh(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 1361 !$ACC HOST(km(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) & 1362 !$ACC HOST(sums_l_l(nzb:nzt+1,0:statistic_regions,0)) & 1363 !$ACC HOST(sums_us2_ws_l(nzb:nzt+1,0)) & 1364 !$ACC HOST(sums_wsus_ws_l(nzb:nzt+1,0)) & 1365 !$ACC HOST(sums_vs2_ws_l(nzb:nzt+1,0)) & 1366 !$ACC HOST(sums_wsvs_ws_l(nzb:nzt+1,0)) & 1367 !$ACC HOST(sums_ws2_ws_l(nzb:nzt+1,0)) & 1368 !$ACC HOST(sums_wspts_ws_l(nzb:nzt+1,0)) & 1369 !$ACC HOST(sums_wssas_ws_l(nzb:nzt+1,0)) & 1370 !$ACC HOST(sums_wsqs_ws_l(nzb:nzt+1,0)) & 1371 !$ACC HOST(sums_wsqcs_ws_l(nzb:nzt+1,0)) & 1372 !$ACC HOST(sums_wsqrs_ws_l(nzb:nzt+1,0)) & 1373 !$ACC HOST(sums_wsncs_ws_l(nzb:nzt+1,0)) & 1374 !$ACC HOST(sums_wsnrs_ws_l(nzb:nzt+1,0)) & 1375 !$ACC HOST(sums_wsss_ws_l(nzb:nzt+1,0)) & 1376 !$ACC HOST(sums_salsa_ws_l(nzb:nzt+1,0)) 1377 #ifdef _OPENACC 1378 CALL exit_surface_arrays 1379 #endif 1380 1254 1381 ! 1255 1382 !-- If required, consider chemical emissions … … 1655 1782 ENDDO ! time loop 1656 1783 1784 !$ACC END DATA 1785 !$ACC END DATA 1786 !$ACC END DATA 1787 !$ACC END DATA 1788 !$ACC END DATA 1789 !$ACC END DATA 1790 !$ACC END DATA 1791 1657 1792 ! 1658 1793 !-- Vertical nesting: Deallocate variables initialized for vertical nesting -
palm/trunk/SOURCE/timestep.f90
r3311 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3311 2018-10-05 12:34:56Z raasch 27 30 ! Stokes drift is regarded in timestep calculation 28 31 ! … … 204 207 REAL(wp), DIMENSION(3) :: reduce_l !< 205 208 REAL(wp), DIMENSION(nzb+1:nzt) :: dxyz2_min !< 209 !$ACC DECLARE CREATE(dxyz2_min) 206 210 207 211 … … 277 281 dt_v_l = 999999.9_wp 278 282 dt_w_l = 999999.9_wp 283 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 284 !$ACC COPY(dt_u_l, dt_v_l, dt_w_l, u_stokes_zu, v_stokes_zu) & 285 !$ACC REDUCTION(MIN: dt_u_l, dt_v_l, dt_w_l) & 286 !$ACC PRESENT(u, v, w, dzu) 279 287 DO i = nxl, nxr 280 288 DO j = nys, nyn … … 313 321 dt_diff_l = 999999.0_wp 314 322 323 !$ACC PARALLEL LOOP PRESENT(dxyz2_min, dzw) 315 324 DO k = nzb+1, nzt 316 325 dxyz2_min(k) = MIN( dx2, dy2, dzw(k)*dzw(k) ) * 0.125_wp … … 319 328 !$OMP PARALLEL private(i,j,k) reduction(MIN: dt_diff_l) 320 329 !$OMP DO 330 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 331 !$ACC COPY(dt_diff_l) REDUCTION(MIN: dt_diff_l) & 332 !$ACC PRESENT(dxyz2_min, kh, km) 321 333 DO i = nxl, nxr 322 334 DO j = nys, nyn -
palm/trunk/SOURCE/timestep_scheme_steering.f90
r2718 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 2718 2018-01-02 08:49:38Z maronga 27 30 ! Corrected "Former revisions" section 28 31 ! … … 90 93 ENDIF 91 94 95 !$ACC UPDATE DEVICE(tsc(1:5)) 96 92 97 ELSEIF ( timestep_scheme == 'euler' ) THEN 93 98 ! -
palm/trunk/SOURCE/transpose.f90
r3241 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3241 2018-09-12 15:02:00Z raasch 27 30 ! unused variables removed 28 31 ! … … 119 122 !$OMP PARALLEL PRIVATE ( i, j, k ) 120 123 !$OMP DO 124 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 125 !$ACC PRESENT(f_inv, f_in) 121 126 DO i = 0, nx 122 127 DO k = nzb_x, nzt_x … … 166 171 167 172 REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) :: work !< 173 !$ACC DECLARE CREATE(work) 168 174 169 175 … … 174 180 !-- Transpose array 175 181 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait ) 182 !$ACC UPDATE HOST(f_inv) 176 183 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 177 184 CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, & 178 185 work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, & 179 186 comm1dy, ierr ) 187 !$ACC UPDATE DEVICE(work) 180 188 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 181 189 … … 186 194 DO l = 0, pdims(2) - 1 187 195 ys = 0 + l * ( nyn_x - nys_x + 1 ) 196 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 197 !$ACC PRESENT(f_out, work) 188 198 DO i = nxl_y, nxr_y 189 199 DO k = nzb_y, nzt_y … … 203 213 !$OMP PARALLEL PRIVATE ( i, j, k ) 204 214 !$OMP DO 215 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 216 !$ACC PRESENT(f_out, f_inv) 205 217 DO k = nzb_y, nzt_y 206 218 DO i = nxl_y, nxr_y … … 246 258 !$OMP PARALLEL PRIVATE ( i, j, k ) 247 259 !$OMP DO 260 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 261 !$ACC PRESENT(f_out, f_inv) 248 262 DO k = 1, nz 249 263 DO i = nxl, nxr … … 293 307 294 308 REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) :: work !< 309 !$ACC DECLARE CREATE(work) 295 310 296 311 … … 307 322 DO l = 0, pdims(1) - 1 308 323 xs = 0 + l * nnx 324 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 325 !$ACC PRESENT(work, f_in) 309 326 DO k = nzb_x, nzt_x 310 327 DO i = xs, xs + nnx - 1 … … 320 337 !-- Transpose array 321 338 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait ) 339 !$ACC UPDATE HOST(work) 322 340 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 323 341 CALL MPI_ALLTOALL( work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, & 324 342 f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, & 325 343 comm1dx, ierr ) 344 !$ACC UPDATE DEVICE(f_inv) 326 345 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 327 346 #endif … … 333 352 !$OMP PARALLEL PRIVATE ( i, j, k ) 334 353 !$OMP DO 354 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 355 !$ACC PRESENT(f_inv, f_in) 335 356 DO i = nxl, nxr 336 357 DO j = nys, nyn … … 378 399 !$OMP PARALLEL PRIVATE ( i, j, k ) 379 400 !$OMP DO 401 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 402 !$ACC PRESENT(f_out, f_inv) 380 403 DO i = 0, nx 381 404 DO k = nzb_x, nzt_x … … 425 448 426 449 REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) :: work !< 450 !$ACC DECLARE CREATE(work) 427 451 428 452 … … 436 460 DO l = 0, pdims(2) - 1 437 461 ys = 0 + l * ( nyn_x - nys_x + 1 ) 462 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 463 !$ACC PRESENT(work, f_in) 438 464 DO i = nxl_y, nxr_y 439 465 DO k = nzb_y, nzt_y … … 449 475 !-- Transpose array 450 476 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait ) 477 !$ACC UPDATE HOST(work) 451 478 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 452 479 CALL MPI_ALLTOALL( work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, & 453 480 f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, & 454 481 comm1dy, ierr ) 482 !$ACC UPDATE DEVICE(f_inv) 455 483 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 456 484 #endif … … 462 490 !$OMP PARALLEL PRIVATE ( i, j, k ) 463 491 !$OMP DO 492 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 493 !$ACC PRESENT(f_inv, f_in) 464 494 DO i = nxl_y, nxr_y 465 495 DO k = nzb_y, nzt_y … … 587 617 !$OMP PARALLEL PRIVATE ( i, j, k ) 588 618 !$OMP DO 619 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 620 !$ACC PRESENT(f_inv, f_in) 589 621 DO j = 0, ny 590 622 DO k = nzb_y, nzt_y … … 634 666 635 667 REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) :: work !< 668 !$ACC DECLARE CREATE(work) 636 669 637 670 … … 643 676 !$OMP PARALLEL PRIVATE ( i, j, k ) 644 677 !$OMP DO 678 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 679 !$ACC PRESENT(f_out, f_inv) 645 680 DO j = 0, ny 646 681 DO k = nzb_y, nzt_y … … 658 693 !-- Transpose array 659 694 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait ) 695 !$ACC UPDATE HOST(f_inv) 660 696 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 661 697 CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, & 662 698 work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, & 663 699 comm1dx, ierr ) 700 !$ACC UPDATE DEVICE(work) 664 701 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 665 702 … … 670 707 DO l = 0, pdims(1) - 1 671 708 zs = 1 + l * ( nzt_y - nzb_y + 1 ) 709 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 710 !$ACC PRESENT(f_out, work) 672 711 DO j = nys_z, nyn_z 673 712 DO k = zs, zs + nzt_y - nzb_y … … 714 753 !$OMP PARALLEL PRIVATE ( i, j, k ) 715 754 !$OMP DO 755 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 756 !$ACC PRESENT(f_in, f_inv) 716 757 DO k = 1,nz 717 758 DO i = nxl, nxr … … 761 802 762 803 REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) :: work !< 804 !$ACC DECLARE CREATE(work) 763 805 764 806 … … 770 812 !$OMP PARALLEL PRIVATE ( i, j, k ) 771 813 !$OMP DO 814 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 815 !$ACC PRESENT(f_out, f_inv) 772 816 DO k = 1, nz 773 817 DO i = nxl, nxr … … 785 829 !-- Transpose array 786 830 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait ) 831 !$ACC UPDATE HOST(f_inv) 787 832 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 788 833 CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, & 789 834 work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, & 790 835 comm1dx, ierr ) 836 !$ACC UPDATE DEVICE(work) 791 837 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 792 838 … … 797 843 DO l = 0, pdims(1) - 1 798 844 xs = 0 + l * nnx 845 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 846 !$ACC PRESENT(f_out, work) 799 847 DO k = nzb_x, nzt_x 800 848 DO i = xs, xs + nnx - 1 … … 845 893 !$OMP PARALLEL PRIVATE ( i, j, k ) 846 894 !$OMP DO 895 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 896 !$ACC PRESENT(f_out, f_inv) 847 897 DO k = nzb_y, nzt_y 848 898 DO j = 0, ny … … 892 942 893 943 REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) :: work !< 944 !$ACC DECLARE CREATE(work) 894 945 895 946 ! … … 905 956 DO l = 0, pdims(1) - 1 906 957 zs = 1 + l * ( nzt_y - nzb_y + 1 ) 958 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 959 !$ACC PRESENT(work, f_in) 907 960 DO j = nys_z, nyn_z 908 961 DO k = zs, zs + nzt_y - nzb_y … … 918 971 !-- Transpose array 919 972 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait ) 973 !$ACC UPDATE HOST(work) 920 974 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 921 975 CALL MPI_ALLTOALL( work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, & 922 976 f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, & 923 977 comm1dx, ierr ) 978 !$ACC UPDATE DEVICE(f_inv) 924 979 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 925 980 #endif … … 930 985 !$OMP PARALLEL PRIVATE ( i, j, k ) 931 986 !$OMP DO 987 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 988 !$ACC PRESENT(f_inv, f_in) 932 989 DO k = nzb_y, nzt_y 933 990 DO j = 0, ny -
palm/trunk/SOURCE/tridia_solver_mod.f90
r3274 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3274 2018-09-24 15:42:55Z knoop 27 30 ! Modularization of all bulk cloud physics code components 28 31 ! … … 150 153 151 154 USE arrays_3d, & 152 ONLY: ddzu_pres, ddzw, rho_air_zw 155 ONLY: ddzu_pres, ddzw, rho_air_zw, tri 153 156 154 157 IMPLICIT NONE … … 169 172 CALL maketri 170 173 CALL split 174 175 !$ACC ENTER DATA & 176 !$ACC COPYIN(ddzuw(0:nz-1,1:3)) & 177 !$ACC COPYIN(tri(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1,1:2)) 171 178 172 179 END SUBROUTINE tridia_init … … 290 297 291 298 REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1) :: ar1 !< 299 !$ACC DECLARE CREATE(ar1) 292 300 293 301 ! 294 302 !-- Forward substitution 303 !$ACC PARALLEL PRESENT(ar, ar1, tri) PRIVATE(i,j,k) 295 304 DO k = 0, nz - 1 305 !$ACC LOOP COLLAPSE(2) 296 306 DO j = nys_z, nyn_z 297 307 DO i = nxl_z, nxr_z … … 306 316 ENDDO 307 317 ENDDO 318 !$ACC END PARALLEL 308 319 309 320 ! … … 312 323 !-- by zero appearing if the pressure bc is set to neumann at the top of 313 324 !-- the model domain. 325 !$ACC PARALLEL PRESENT(ar, ar1, ddzuw, tri) PRIVATE(i,j,k) 314 326 DO k = nz-1, 0, -1 327 !$ACC LOOP COLLAPSE(2) 315 328 DO j = nys_z, nyn_z 316 329 DO i = nxl_z, nxr_z … … 325 338 ENDDO 326 339 ENDDO 340 !$ACC END PARALLEL 327 341 328 342 ! … … 332 346 IF ( ibc_p_b == 1 .AND. ibc_p_t == 1 ) THEN 333 347 IF ( nys_z == 0 .AND. nxl_z == 0 ) THEN 348 !$ACC PARALLEL LOOP PRESENT(ar) 334 349 DO k = 1, nz 335 350 ar(nxl_z,nys_z,k) = 0.0_wp -
palm/trunk/SOURCE/turbulence_closure_mod.f90
r3550 r3634 25 25 ! ----------------- 26 26 ! $Id$ 27 ! OpenACC port for SPEC 28 ! 29 ! 3550 2018-11-21 16:01:01Z gronemeier 27 30 ! - calculate diss production same in vector and cache optimization 28 31 ! - move boundary condition for e and diss to boundary_conds … … 1619 1622 ENDDO !k loop 1620 1623 1624 !$ACC ENTER DATA COPYIN(l_black(nzb:nzt+1)) 1625 1621 1626 ENDIF !LES or RANS mode 1622 1627 … … 1624 1629 !-- Set lateral boundary conditions for l_wall 1625 1630 CALL exchange_horiz( l_wall, nbgp ) 1631 1632 !$ACC ENTER DATA COPYIN(l_grid(nzb:nzt+1)) & 1633 !$ACC COPYIN(l_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) 1626 1634 1627 1635 CONTAINS … … 1777 1785 !-- Default surfaces, upward-facing 1778 1786 !$OMP PARALLEL DO PRIVATE(i,j,k,m) 1787 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) & 1788 !$ACC PRESENT(surf_def_h(0), u, v, drho_air_zw, zu) 1779 1789 DO m = 1, surf_def_h(0)%ns 1780 1790 … … 1811 1821 !-- Default surfaces, downward-facing surfaces 1812 1822 !$OMP PARALLEL DO PRIVATE(i,j,k,m) 1823 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) & 1824 !$ACC PRESENT(surf_def_h(1), u, v, drho_air_zw, zu, km) 1813 1825 DO m = 1, surf_def_h(1)%ns 1814 1826 … … 1842 1854 !-- Natural surfaces, upward-facing 1843 1855 !$OMP PARALLEL DO PRIVATE(i,j,k,m) 1856 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) & 1857 !$ACC PRESENT(surf_lsm_h, u, v, drho_air_zw, zu) 1844 1858 DO m = 1, surf_lsm_h%ns 1845 1859 … … 1876 1890 !-- Urban surfaces, upward-facing 1877 1891 !$OMP PARALLEL DO PRIVATE(i,j,k,m) 1892 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) & 1893 !$ACC PRESENT(surf_usm_h, u, v, drho_air_zw, zu) 1878 1894 DO m = 1, surf_usm_h%ns 1879 1895 … … 1970 1986 CALL advec_s_up( e ) 1971 1987 ELSE 1988 !$ACC KERNELS PRESENT(tend) 1972 1989 tend = 0.0_wp 1990 !$ACC END KERNELS 1973 1991 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1974 1992 IF ( ws_scheme_sca ) THEN … … 2006 2024 !-- reasons in the course of the integration. In such cases the old TKE 2007 2025 !-- value is reduced by 90%. 2026 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 2027 !$ACC PRESENT(e, tend, te_m, wall_flags_0) & 2028 !$ACC PRESENT(tsc(3:3)) & 2029 !$ACC PRESENT(e_p) 2008 2030 DO i = nxl, nxr 2009 2031 DO j = nys, nyn … … 2024 2046 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2025 2047 IF ( intermediate_timestep_count == 1 ) THEN 2048 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 2049 !$ACC PRESENT(tend, te_m) 2026 2050 DO i = nxl, nxr 2027 2051 DO j = nys, nyn … … 2033 2057 ELSEIF ( intermediate_timestep_count < & 2034 2058 intermediate_timestep_count_max ) THEN 2059 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 2060 !$ACC PRESENT(tend, te_m) 2035 2061 DO i = nxl, nxr 2036 2062 DO j = nys, nyn … … 2380 2406 !-- points first, gradients at surface-bounded grid points will be 2381 2407 !-- overwritten further below. 2408 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, l) & 2409 !$ACC PRIVATE(surf_s, surf_e) & 2410 !$ACC PRIVATE(dudx(:), dudy(:), dudz(:), dvdx(:), dvdy(:), dvdz(:), dwdx(:), dwdy(:), dwdz(:)) & 2411 !$ACC PRESENT(e, u, v, w, diss, dd2zu, ddzw, km, wall_flags_0) & 2412 !$ACC PRESENT(tend) & 2413 !$ACC PRESENT(surf_def_h(0:1), surf_def_v(0:3)) & 2414 !$ACC PRESENT(surf_lsm_h, surf_lsm_v(0:3)) & 2415 !$ACC PRESENT(surf_usm_h, surf_usm_v(0:3)) 2382 2416 DO i = nxl, nxr 2383 2417 DO j = nys, nyn 2418 !$ACC LOOP PRIVATE(k) 2384 2419 DO k = nzb+1, nzt 2385 2420 … … 2423 2458 surf_s = surf_def_v(l)%start_index(j,i) 2424 2459 surf_e = surf_def_v(l)%end_index(j,i) 2460 !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir) 2425 2461 DO m = surf_s, surf_e 2426 2462 k = surf_def_v(l)%k(m) … … 2441 2477 surf_s = surf_lsm_v(l)%start_index(j,i) 2442 2478 surf_e = surf_lsm_v(l)%end_index(j,i) 2479 !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir) 2443 2480 DO m = surf_s, surf_e 2444 2481 k = surf_lsm_v(l)%k(m) … … 2459 2496 surf_s = surf_usm_v(l)%start_index(j,i) 2460 2497 surf_e = surf_usm_v(l)%end_index(j,i) 2498 !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir) 2461 2499 DO m = surf_s, surf_e 2462 2500 k = surf_usm_v(l)%k(m) … … 2479 2517 surf_s = surf_def_v(l)%start_index(j,i) 2480 2518 surf_e = surf_def_v(l)%end_index(j,i) 2519 !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir) 2481 2520 DO m = surf_s, surf_e 2482 2521 k = surf_def_v(l)%k(m) … … 2497 2536 surf_s = surf_lsm_v(l)%start_index(j,i) 2498 2537 surf_e = surf_lsm_v(l)%end_index(j,i) 2538 !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir) 2499 2539 DO m = surf_s, surf_e 2500 2540 k = surf_lsm_v(l)%k(m) … … 2515 2555 surf_s = surf_usm_v(l)%start_index(j,i) 2516 2556 surf_e = surf_usm_v(l)%end_index(j,i) 2557 !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir) 2517 2558 DO m = surf_s, surf_e 2518 2559 k = surf_usm_v(l)%k(m) … … 2534 2575 surf_s = surf_def_h(0)%start_index(j,i) 2535 2576 surf_e = surf_def_h(0)%end_index(j,i) 2577 !$ACC LOOP PRIVATE(m, k) 2536 2578 DO m = surf_s, surf_e 2537 2579 k = surf_def_h(0)%k(m) … … 2550 2592 surf_s = surf_lsm_h%start_index(j,i) 2551 2593 surf_e = surf_lsm_h%end_index(j,i) 2594 !$ACC LOOP PRIVATE(m, k) 2552 2595 DO m = surf_s, surf_e 2553 2596 k = surf_lsm_h%k(m) … … 2561 2604 surf_s = surf_usm_h%start_index(j,i) 2562 2605 surf_e = surf_usm_h%end_index(j,i) 2606 !$ACC LOOP PRIVATE(m, k) 2563 2607 DO m = surf_s, surf_e 2564 2608 k = surf_usm_h%k(m) … … 2573 2617 surf_s = surf_def_h(1)%start_index(j,i) 2574 2618 surf_e = surf_def_h(1)%end_index(j,i) 2619 !$ACC LOOP PRIVATE(m, k) 2575 2620 DO m = surf_s, surf_e 2576 2621 k = surf_def_h(1)%k(m) … … 2585 2630 2586 2631 2632 !$ACC LOOP PRIVATE(k, def, flag) 2587 2633 DO k = nzb+1, nzt 2588 2634 … … 2684 2730 ELSE ! or IF ( .NOT. ocean_mode ) THEN 2685 2731 2732 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 2733 !$ACC PRIVATE(surf_s, surf_e) & 2734 !$ACC PRIVATE(tmp_flux(nzb+1:nzt)) & 2735 !$ACC PRESENT(e, diss, kh, pt, dd2zu, drho_air_zw, wall_flags_0) & 2736 !$ACC PRESENT(tend) & 2737 !$ACC PRESENT(surf_def_h(0:2)) & 2738 !$ACC PRESENT(surf_lsm_h) & 2739 !$ACC PRESENT(surf_usm_h) 2686 2740 DO i = nxl, nxr 2687 2741 DO j = nys, nyn 2688 2742 2743 !$ACC LOOP PRIVATE(k) 2689 2744 DO k = nzb+1, nzt 2690 2745 tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k) … … 2697 2752 surf_s = surf_def_h(l)%start_index(j,i) 2698 2753 surf_e = surf_def_h(l)%end_index(j,i) 2754 !$ACC LOOP PRIVATE(m, k) 2699 2755 DO m = surf_s, surf_e 2700 2756 k = surf_def_h(l)%k(m) … … 2706 2762 surf_s = surf_lsm_h%start_index(j,i) 2707 2763 surf_e = surf_lsm_h%end_index(j,i) 2764 !$ACC LOOP PRIVATE(m, k) 2708 2765 DO m = surf_s, surf_e 2709 2766 k = surf_lsm_h%k(m) … … 2714 2771 surf_s = surf_usm_h%start_index(j,i) 2715 2772 surf_e = surf_usm_h%end_index(j,i) 2773 !$ACC LOOP PRIVATE(m, k) 2716 2774 DO m = surf_s, surf_e 2717 2775 k = surf_usm_h%k(m) … … 2723 2781 surf_s = surf_def_h(2)%start_index(j,i) 2724 2782 surf_e = surf_def_h(2)%end_index(j,i) 2783 !$ACC LOOP PRIVATE(m, k) 2725 2784 DO m = surf_s, surf_e 2726 2785 k = surf_def_h(2)%k(m) … … 2732 2791 2733 2792 !-- Compute tendency for TKE-production from shear 2793 !$ACC LOOP PRIVATE(k, flag) 2734 2794 DO k = nzb+1, nzt 2735 2795 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_0(k,j,i),0) ) … … 3628 3688 3629 3689 USE arrays_3d, & 3630 ONLY: ddzu, ddzw, drho_air, rho_air_zw 3690 ONLY: ddzu, dd2zu, ddzw, drho_air, rho_air_zw 3691 3692 USE control_parameters, & 3693 ONLY: atmos_ocean_sign, use_single_reference_value, & 3694 wall_adjustment, wall_adjustment_factor 3631 3695 3632 3696 USE grid_variables, & … … 3653 3717 REAL(wp) :: ll !< adjusted l 3654 3718 REAL(wp) :: var_reference !< reference temperature 3719 #ifdef _OPENACC 3720 ! 3721 !-- From mixing_length_les: 3722 REAL(wp) :: l_stable !< mixing length according to stratification 3723 ! 3724 !-- From mixing_length_rans: 3725 REAL(wp) :: duv2_dz2 !< squared vertical gradient of wind vector 3726 REAL(wp) :: l_diss !< mixing length for dissipation 3727 REAL(wp) :: rif !< Richardson flux number 3728 ! 3729 !-- From both: 3730 REAL(wp) :: dvar_dz !< vertical gradient of var 3731 #endif 3655 3732 3656 3733 #if defined( __nopointer ) … … 3659 3736 REAL(wp), DIMENSION(:,:,:), POINTER :: var !< temperature 3660 3737 #endif 3661 REAL(wp) , DIMENSION(nzb+1:nzt,nys:nyn):: dissipation !< TKE dissipation3738 REAL(wp) :: dissipation !< TKE dissipation 3662 3739 3663 3740 3664 3741 ! 3665 3742 !-- Calculate the tendency terms 3743 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 3744 !$ACC PRIVATE(flag, l, ll, dissipation) & 3745 !$ACC PRIVATE(l_stable, duv2_dz2, l_diss, rif, dvar_dz) & 3746 !$ACC PRESENT(e, u, v, km, var, wall_flags_0) & 3747 !$ACC PRESENT(ddzu, dd2zu, ddzw, rho_air_zw, drho_air) & 3748 !$ACC PRESENT(l_black, l_grid, l_wall) & 3749 !$ACC PRESENT(diss, tend) 3666 3750 DO i = nxl, nxr 3667 3751 DO j = nys, nyn … … 3675 3759 IF ( les_dynamic .OR. les_mw ) THEN 3676 3760 3761 #ifdef _OPENACC 3762 ! 3763 !-- Cannot call subroutine mixing_length_les because after adding all required 3764 !-- OpenACC directives the execution crashed reliably when inside the called 3765 !-- subroutine. I'm not sure why that is... 3766 dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k) 3767 IF ( dvar_dz > 0.0_wp ) THEN 3768 IF ( use_single_reference_value ) THEN 3769 l_stable = 0.76_wp * SQRT( e(k,j,i) ) & 3770 / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp 3771 ELSE 3772 l_stable = 0.76_wp * SQRT( e(k,j,i) ) & 3773 / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp 3774 ENDIF 3775 ELSE 3776 l_stable = l_grid(k) 3777 ENDIF 3778 ! 3779 !-- Adjustment of the mixing length 3780 IF ( wall_adjustment ) THEN 3781 l = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k), l_stable ) 3782 ll = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k) ) 3783 ELSE 3784 l = MIN( l_grid(k), l_stable ) 3785 ll = l_grid(k) 3786 ENDIF 3787 #else 3677 3788 CALL mixing_length_les( i, j, k, l, ll, var, var_reference ) 3678 3679 dissipation(k,j) = ( 0.19_wp + 0.74_wp * l / ll ) & 3680 * e(k,j,i) * SQRT( e(k,j,i) ) / l 3789 #endif 3790 3791 dissipation = ( 0.19_wp + 0.74_wp * l / ll ) & 3792 * e(k,j,i) * SQRT( e(k,j,i) ) / l 3681 3793 3682 3794 ELSEIF ( rans_tke_l ) THEN 3683 3795 3796 #ifdef _OPENACC 3797 ! 3798 !-- Same reason as above... 3799 dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k) 3800 3801 duv2_dz2 = ( ( u(k+1,j,i) - u(k-1,j,i) ) * dd2zu(k) )**2 & 3802 + ( ( v(k+1,j,i) - v(k-1,j,i) ) * dd2zu(k) )**2 & 3803 + 1E-30_wp 3804 3805 IF ( use_single_reference_value ) THEN 3806 rif = g / var_reference * dvar_dz / duv2_dz2 3807 ELSE 3808 rif = g / var(k,j,i) * dvar_dz / duv2_dz2 3809 ENDIF 3810 3811 rif = MAX( rif, -5.0_wp ) 3812 rif = MIN( rif, 1.0_wp ) 3813 3814 ! 3815 !-- Calculate diabatic mixing length using Dyer-profile functions 3816 IF ( rif >= 0.0_wp ) THEN 3817 l = MIN( l_black(k) / ( 1.0_wp + 5.0_wp * rif ), l_wall(k,j,i) ) 3818 l_diss = l 3819 ELSE 3820 ! 3821 !-- In case of unstable stratification, use mixing length of neutral case 3822 !-- for l, but consider profile functions for l_diss 3823 l = l_wall(k,j,i) 3824 l_diss = l * SQRT( 1.0_wp - 16.0_wp * rif ) 3825 ENDIF 3826 #else 3684 3827 CALL mixing_length_rans( i, j, k, l, ll, var, var_reference ) 3685 3686 dissipation(k,j) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) ) / ll 3687 3688 diss(k,j,i) = dissipation(k,j) * flag 3828 #endif 3829 3830 dissipation = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) ) / ll 3831 3832 diss(k,j,i) = dissipation * flag 3689 3833 3690 3834 ELSEIF ( rans_tke_e ) THEN 3691 3835 3692 dissipation (k,j)= diss(k,j,i)3836 dissipation = diss(k,j,i) 3693 3837 3694 3838 ENDIF … … 3710 3854 ) * ddzw(k) * drho_air(k) & 3711 3855 ) * flag * dsig_e & 3712 - dissipation(k,j) * flag 3856 - dissipation * flag 3857 ! 3858 !-- Store dissipation if needed for calculating the sgs particle 3859 !-- velocities 3860 IF ( .NOT. rans_tke_e .AND. ( use_sgs_for_particles .OR. & 3861 wang_kernel .OR. collision_turbulence ) ) THEN 3862 diss(k,j,i) = dissipation * flag 3863 ENDIF 3713 3864 3714 3865 ENDDO 3715 3866 ENDDO 3716 3717 !3718 !-- Store dissipation if needed for calculating the sgs particle3719 !-- velocities3720 IF ( .NOT. rans_tke_e .AND. ( use_sgs_for_particles .OR. &3721 wang_kernel .OR. collision_turbulence ) ) THEN3722 DO j = nys, nyn3723 DO k = nzb+1, nzt3724 diss(k,j,i) = dissipation(k,j) * MERGE( 1.0_wp, 0.0_wp, &3725 BTEST( wall_flags_0(k,j,i), 0 ) )3726 ENDDO3727 ENDDO3728 ENDIF3729 3730 3867 ENDDO 3731 3868 … … 4257 4394 !-- Downward facing surfaces 4258 4395 !$OMP PARALLEL DO PRIVATE(i,j,k) 4396 !$ACC PARALLEL LOOP PRIVATE(i,j,k) & 4397 !$ACC PRESENT(bc_h(1), kh, km) 4259 4398 DO m = 1, bc_h(1)%ns 4260 4399 i = bc_h(1)%i(m) … … 4267 4406 !-- Downward facing surfaces 4268 4407 !$OMP PARALLEL DO PRIVATE(i,j,k) 4408 !$ACC PARALLEL LOOP PRIVATE(i,j,k) & 4409 !$ACC PRESENT(bc_h(0), kh, km) 4269 4410 DO m = 1, bc_h(0)%ns 4270 4411 i = bc_h(0)%i(m) … … 4277 4418 !-- Model top 4278 4419 !$OMP PARALLEL DO 4420 !$ACC PARALLEL LOOP COLLAPSE(2) & 4421 !$ACC PRESENT(kh, km) 4279 4422 DO i = nxlg, nxrg 4280 4423 DO j = nysg, nyng … … 4315 4458 SUBROUTINE tcm_diffusivities_default( var, var_reference ) 4316 4459 4460 USE arrays_3d, & 4461 ONLY: dd2zu 4462 4463 USE control_parameters, & 4464 ONLY: atmos_ocean_sign, use_single_reference_value, & 4465 wall_adjustment, wall_adjustment_factor 4466 4317 4467 USE statistics, & 4318 4468 ONLY : rmask, sums_l_l … … 4331 4481 REAL(wp) :: ll !< adjusted mixing length 4332 4482 REAL(wp) :: var_reference !< reference temperature 4483 #ifdef _OPENACC 4484 ! 4485 !-- From mixing_length_les: 4486 REAL(wp) :: l_stable !< mixing length according to stratification 4487 REAL(wp) :: dvar_dz !< vertical gradient of var 4488 #endif 4333 4489 4334 4490 #if defined( __nopointer ) … … 4344 4500 ! 4345 4501 !-- Initialization for calculation of the mixing length profile 4502 !$ACC KERNELS PRESENT(sums_l_l) 4346 4503 sums_l_l = 0.0_wp 4504 !$ACC END KERNELS 4347 4505 4348 4506 ! … … 4353 4511 IF ( les_dynamic .OR. les_mw ) THEN 4354 4512 !$OMP DO 4513 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(sr) & 4514 !$ACC PRIVATE(flag, dvar_dz, l_stable, l, ll) & 4515 !$ACC PRESENT(wall_flags_0, var, dd2zu, e, l_wall, l_grid, rmask) & 4516 !$ACC PRESENT(kh, km, sums_l_l) 4355 4517 DO i = nxlg, nxrg 4356 4518 DO j = nysg, nyng … … 4361 4523 ! 4362 4524 !-- Determine the mixing length for LES closure 4525 #ifdef _OPENACC 4526 ! 4527 !-- Cannot call subroutine mixing_length_les because after adding all required 4528 !-- OpenACC directives the execution crashed reliably when inside the called 4529 !-- subroutine. I'm not sure why that is... 4530 dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k) 4531 IF ( dvar_dz > 0.0_wp ) THEN 4532 IF ( use_single_reference_value ) THEN 4533 l_stable = 0.76_wp * SQRT( e(k,j,i) ) & 4534 / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp 4535 ELSE 4536 l_stable = 0.76_wp * SQRT( e(k,j,i) ) & 4537 / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp 4538 ENDIF 4539 ELSE 4540 l_stable = l_grid(k) 4541 ENDIF 4542 ! 4543 !-- Adjustment of the mixing length 4544 IF ( wall_adjustment ) THEN 4545 l = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k), l_stable ) 4546 ll = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k) ) 4547 ELSE 4548 l = MIN( l_grid(k), l_stable ) 4549 ll = l_grid(k) 4550 ENDIF 4551 #else 4363 4552 CALL mixing_length_les( i, j, k, l, ll, var, var_reference ) 4553 #endif 4554 4364 4555 ! 4365 4556 !-- Compute diffusion coefficients for momentum and heat … … 4429 4620 ENDIF 4430 4621 4622 !$ACC KERNELS PRESENT(sums_l_l) 4431 4623 sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn) ! quasi boundary-condition for 4432 4624 ! data output 4625 !$ACC END KERNELS 4433 4626 !$OMP END PARALLEL 4434 4627
Note: See TracChangeset
for help on using the changeset viewer.
