Changeset 3634 for palm/trunk/SOURCE


Ignore:
Timestamp:
Dec 18, 2018 12:31:28 PM (6 years ago)
Author:
knoop
Message:

OpenACC port for SPEC

Location:
palm/trunk/SOURCE
Files:
1 added
23 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/Makefile

    r3579 r3634  
    2525# -----------------
    2626# $Id$
     27# OpenACC port for SPEC
     28#
     29# 3579 2018-11-29 15:32:39Z suehring
    2730# Dependency for check_parameters on nesting_offl_mod added
    2831#
     
    554557        coriolis.f90 \
    555558        cpulog_mod.f90 \
     559        cuda_fft_interfaces.f90 \
    556560        data_log.f90 \
    557561        data_output_2d.f90 \
     
    919923        mod_kinds.o \
    920924        modules.o
     925cuda_fft_interfaces.o: \
     926        cuda_fft_interfaces.f90 \
     927        modules.o \
     928        mod_kinds.o
    921929data_log.o: \
    922930        mod_kinds.o \
     
    10421050        pmc_interface_mod.o
    10431051fft_xy_mod.o: \
     1052        cuda_fft_interfaces.o \
    10441053        mod_kinds.o \
    10451054        modules.o \
  • palm/trunk/SOURCE/advec_ws.f90

    r3589 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3589 2018-11-30 15:09:51Z suehring
    2730! Move the control parameter "salsa" from salsa_mod to control_parameters
    2831! (M. Kurppa)
     
    11431146!--    beginning of prognostic_equations.
    11441147       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)
    11451150          sums_wsus_ws_l = 0.0_wp
    11461151          sums_wsvs_ws_l = 0.0_wp
     
    11481153          sums_vs2_ws_l  = 0.0_wp
    11491154          sums_ws2_ws_l  = 0.0_wp
     1155          !$ACC END KERNELS
    11501156       ENDIF
    11511157
    11521158       IF ( ws_scheme_sca )  THEN
     1159          !$ACC KERNELS PRESENT(sums_wspts_ws_l)
    11531160          sums_wspts_ws_l = 0.0_wp
     1161          !$ACC END KERNELS
    11541162          IF ( humidity       )  sums_wsqs_ws_l = 0.0_wp
    11551163          IF ( passive_scalar )  sums_wsss_ws_l = 0.0_wp
     
    33003308
    33013309       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
    33023311       
    33033312       INTEGER(iwp) ::  i      !< grid index along x-direction
     
    33203329       REAL(wp) ::  ibit1  !< flag indicating 3rd-order scheme along x-direction
    33213330       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
    33223336       REAL(wp) ::  ibit3  !< flag indicating 1st-order scheme along y-direction
    33233337       REAL(wp) ::  ibit4  !< flag indicating 3rd-order scheme along y-direction
    33243338       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
    33253344       REAL(wp) ::  ibit6  !< flag indicating 1st-order scheme along z-direction
    33263345       REAL(wp) ::  ibit7  !< flag indicating 3rd-order scheme along z-direction
     
    33303349       REAL(wp) ::  flux_d !< 6th-order flux at grid box bottom
    33313350       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
    33323354       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
    33333358       
    3334        REAL(wp), DIMENSION(nzb:nzt)  ::  diss_n !< discretized artificial dissipation at northward-side of the grid box
    3335        REAL(wp), DIMENSION(nzb:nzt)  ::  diss_r !< discretized artificial dissipation at rightward-side of the grid box
    3336        REAL(wp), DIMENSION(nzb:nzt)  ::  diss_t !< discretized artificial dissipation at rightward-side of the grid box
    3337        REAL(wp), DIMENSION(nzb:nzt)  ::  flux_n !< discretized 6th-order flux at northward-side of the grid box
    3338        REAL(wp), DIMENSION(nzb:nzt)  ::  flux_r !< discretized 6th-order flux at rightward-side of the grid box
    3339        REAL(wp), DIMENSION(nzb:nzt)  ::  flux_t !< discretized 6th-order flux at rightward-side of the grid box
     3359       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
    33403365       
     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
    33413369       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local !< discretized artificial dissipation term at southward-side of the grid box
    33423370       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local !< discretized 6th-order flux at northward-side of the grid box
     3371#endif
    33433372       
     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
    33443376       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local !< discretized artificial dissipation term at leftward-side of the grid box
    33453377       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
    33463379       
    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
    33483404!
    33493405!--    Compute the fluxes for the whole left boundary of the processor domain.
     
    34083464
    34093465       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)
    34113489       DO  i = nxl, nxr
    34123490
     3491#ifndef _OPENACC
    34133492          j = nys
    34143493          DO  k = nzb+1, nzb_max
     
    34673546
    34683547          ENDDO
     3548#endif
    34693549
    34703550          DO  j = nys, nyn
    34713551
    3472              flux_t(0) = 0.0_wp
    3473              diss_t(0) = 0.0_wp
    34743552             flux_d    = 0.0_wp
    34753553             diss_d    = 0.0_wp
     
    34813559                ibit0 = REAL( IBITS(advc_flags_1(k,j,i),0,1), KIND = wp )
    34823560
    3483                 u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
    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 * (                                           &
    34853563                          ( 37.0_wp * ibit2 * adv_sca_5                       &
    34863564                      +      7.0_wp * ibit1 * adv_sca_3                       &
     
    34973575                                     )
    34983576
    3499                 diss_r(k) = -ABS( u_comp ) * (                                &
     3577                diss_r = -ABS( u_comp ) * (                                   &
    35003578                          ( 10.0_wp * ibit2 * adv_sca_5                       &
    35013579                       +     3.0_wp * ibit1 * adv_sca_3                       &
     
    35123590                                             )
    35133591
     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
    35143634                ibit5 = REAL( IBITS(advc_flags_1(k,j,i),5,1), KIND = wp )
    35153635                ibit4 = REAL( IBITS(advc_flags_1(k,j,i),4,1), KIND = wp )
    35163636                ibit3 = REAL( IBITS(advc_flags_1(k,j,i),3,1), KIND = wp )
    35173637
    3518                 v_comp    = v(k,j+1,i) - v_gtrans + v_stokes_zu(k)
    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 * (                                           &
    35203640                          ( 37.0_wp * ibit5 * adv_sca_5                       &
    35213641                       +     7.0_wp * ibit4 * adv_sca_3                       &
     
    35323652                                     )
    35333653
    3534                 diss_n(k) = -ABS( v_comp ) * (                                &
     3654                diss_n = -ABS( v_comp ) * (                                   &
    35353655                          ( 10.0_wp * ibit5 * adv_sca_5                       &
    35363656                       +     3.0_wp * ibit4 * adv_sca_3                       &
     
    35463666                             ( sk(k,j+3,i) - sk(k,j-2,i) )                    &
    35473667                                             )
     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
    35483711!
    35493712!--             k index has to be modified near bottom and top, else array
     
    35583721
    35593722
    3560                 flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                      &
     3723                flux_t = w(k,j,i) * rho_air_zw(k) * (                         &
    35613724                           ( 37.0_wp * ibit8 * adv_sca_5                      &
    35623725                        +     7.0_wp * ibit7 * adv_sca_3                      &
     
    35723735                                       )
    35733736
    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) * (                 &
    35753738                           ( 10.0_wp * ibit8 * adv_sca_5                      &
    35763739                        +     3.0_wp * ibit7 * adv_sca_3                      &
     
    36163779
    36173780                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)       &
    36253787                                            ) + sk(k,j,i) * div
    36263788
    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
    36333894
    36343895             ENDDO
     
    36363897             DO  k = nzb_max+1, nzt
    36373898
    3638                 u_comp    = u(k,j,i+1) - u_gtrans + u_stokes_zu(k)
    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 * (                                           &
    36403901                      37.0_wp * ( sk(k,j,i+1) + sk(k,j,i)   )                 &
    36413902                    -  8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) )                 &
    36423903                    +           ( 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 ) * (                                   &
    36443905                      10.0_wp * ( sk(k,j,i+1) - sk(k,j,i)   )                 &
    36453906                    -  5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) )                 &
    36463907                    +           ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5
    36473908
    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 * (                                           &
    36503931                      37.0_wp * ( sk(k,j+1,i) + sk(k,j,i)   )                 &
    36513932                    -  8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) )                 &
    36523933                    +           ( 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 ) * (                                   &
    36543935                      10.0_wp * ( sk(k,j+1,i) - sk(k,j,i)   )                 &
    36553936                    -  5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) )                 &
    36563937                    +           ( 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
    36573958!
    36583959!--             k index has to be modified near bottom and top, else array
     
    36673968
    36683969
    3669                 flux_t(k) = w(k,j,i) * rho_air_zw(k) * (                      &
     3970                flux_t = w(k,j,i) * rho_air_zw(k) * (                      &
    36703971                           ( 37.0_wp * ibit8 * adv_sca_5                      &
    36713972                        +     7.0_wp * ibit7 * adv_sca_3                      &
     
    36813982                                       )
    36823983
    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) * (              &
    36843985                           ( 10.0_wp * ibit8 * adv_sca_5                      &
    36853986                        +     3.0_wp * ibit7 * adv_sca_3                      &
     
    37064007
    37074008                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)       &
    37154015                                            ) + sk(k,j,i) * div
    37164016
    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
    37314032                       sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn)           &
    3732                           + ( flux_t(k)                                        &
     4033                          + ( flux_t                                           &
    37334034                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    37344035                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3735                             + diss_t(k)                                        &
     4036                            + diss_t                                           &
    37364037                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    37374038                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    37384039                            ) * weight_substep(intermediate_timestep_count)
    3739                     ENDDO
    3740                  CASE ( 'sa' )
    3741                     DO  k = nzb, nzt
     4040                    CASE ( 2 )
     4041                       !$ACC ATOMIC
    37424042                       sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn)           &
    3743                           + ( flux_t(k)                                        &
     4043                          + ( flux_t                                           &
    37444044                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    37454045                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3746                             + diss_t(k)                                        &
     4046                            + diss_t                                           &
    37474047                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    37484048                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    37494049                            ) * weight_substep(intermediate_timestep_count)
    3750                     ENDDO
    3751                  CASE ( 'q' )
    3752                     DO  k = nzb, nzt
     4050                    CASE ( 3 )
     4051                       !$ACC ATOMIC
    37534052                       sums_wsqs_ws_l(k,tn)  = sums_wsqs_ws_l(k,tn)            &
    3754                           + ( flux_t(k)                                        &
     4053                          + ( flux_t                                           &
    37554054                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    37564055                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3757                             + diss_t(k)                                        &
     4056                            + diss_t                                           &
    37584057                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    37594058                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    37604059                            ) * weight_substep(intermediate_timestep_count)
    3761                     ENDDO
    3762                  CASE ( 'qc' )
    3763                     DO  k = nzb, nzt
     4060                    CASE ( 4 )
     4061                       !$ACC ATOMIC
    37644062                       sums_wsqcs_ws_l(k,tn)  = sums_wsqcs_ws_l(k,tn)          &
    3765                           + ( flux_t(k)                                        &
     4063                          + ( flux_t                                           &
    37664064                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    37674065                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3768                             + diss_t(k)                                        &
     4066                            + diss_t                                           &
    37694067                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    37704068                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    37714069                            ) * weight_substep(intermediate_timestep_count)
    3772                     ENDDO
    3773                  CASE ( 'qr' )
    3774                     DO  k = nzb, nzt
     4070                    CASE ( 5 )
     4071                       !$ACC ATOMIC
    37754072                       sums_wsqrs_ws_l(k,tn)  = sums_wsqrs_ws_l(k,tn)          &
    3776                           + ( flux_t(k)                                        &
     4073                          + ( flux_t                                           &
    37774074                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    37784075                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3779                             + diss_t(k)                                        &
     4076                            + diss_t                                           &
    37804077                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    37814078                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    37824079                            ) * weight_substep(intermediate_timestep_count)
    3783                     ENDDO
    3784                  CASE ( 'nc' )
    3785                     DO  k = nzb, nzt
     4080                    CASE ( 6 )
     4081                       !$ACC ATOMIC
    37864082                       sums_wsncs_ws_l(k,tn)  = sums_wsncs_ws_l(k,tn)          &
    3787                           + ( flux_t(k)                                        &
     4083                          + ( flux_t                                           &
    37884084                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    37894085                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3790                             + diss_t(k)                                        &
     4086                            + diss_t                                           &
    37914087                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    37924088                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    37934089                            ) * weight_substep(intermediate_timestep_count)
    3794                     ENDDO
    3795                  CASE ( 'nr' )
    3796                     DO  k = nzb, nzt
     4090                    CASE ( 7 )
     4091                       !$ACC ATOMIC
    37974092                       sums_wsnrs_ws_l(k,tn)  = sums_wsnrs_ws_l(k,tn)          &
    3798                           + ( flux_t(k)                                        &
     4093                          + ( flux_t                                           &
    37994094                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    38004095                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3801                             + diss_t(k)                                        &
     4096                            + diss_t                                           &
    38024097                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    38034098                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    38044099                            ) * weight_substep(intermediate_timestep_count)
    3805                     ENDDO
    3806                  CASE ( 's' )
    3807                     DO  k = nzb, nzt
     4100                    CASE ( 8 )
     4101                       !$ACC ATOMIC
    38084102                       sums_wsss_ws_l(k,tn)  = sums_wsss_ws_l(k,tn)            &
    3809                           + ( flux_t(k)                                        &
     4103                          + ( flux_t                                           &
    38104104                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    38114105                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3812                             + diss_t(k)                                        &
     4106                            + diss_t                                           &
    38134107                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    38144108                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    38154109                            ) * 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
    38204112                        sums_salsa_ws_l(k,tn)  = sums_salsa_ws_l(k,tn)         &
    3821                           + ( flux_t(k)                                        &
     4113                          + ( flux_t                                           &
    38224114                                / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) )  &
    38234115                                * ( w(k,j,i) - hom(k,1,3,0)                 )  &
    3824                             + diss_t(k)                                        &
     4116                            + diss_t                                           &
    38254117                                / ( ABS(w(k,j,i)) + 1.0E-20_wp              )  &
    38264118                                *   ABS(w(k,j,i) - hom(k,1,3,0)             )  &
    38274119                            ) * weight_substep(intermediate_timestep_count)
    3828                      ENDDO                   
    3829                                    
    3830 
    3831               END SELECT
     4120
     4121                END SELECT
     4122
     4123             ENDDO
    38324124
    38334125         ENDDO
     
    38744166       REAL(wp)    ::  ibit10 !< flag indicating 3rd-order scheme along x-direction
    38754167       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
    38764173       REAL(wp)    ::  ibit12 !< flag indicating 1st-order scheme along y-direction
    38774174       REAL(wp)    ::  ibit13 !< flag indicating 3rd-order scheme along y-direction
    38784175       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
    38794181       REAL(wp)    ::  ibit15 !< flag indicating 1st-order scheme along z-direction
    38804182       REAL(wp)    ::  ibit16 !< flag indicating 3rd-order scheme along z-direction
     
    38864188       REAL(wp)    ::  gv     !< Galilei-transformation velocity along y
    38874189       REAL(wp)    ::  v_comp !< advection velocity along y
     4190#ifdef _OPENACC
     4191       REAL(wp)    ::  v_comp_s !< advection velocity along y
     4192#endif
    38884193       REAL(wp)    ::  w_comp !< advection velocity along z
    38894194       
     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
    38904198       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_u !< discretized artificial dissipation at southward-side of the grid box
    38914199       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_u !< discretized 6th-order flux at southward-side of the grid box
     4200#endif
    38924201       
     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
    38934205       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_u !< discretized artificial dissipation at leftward-side of the grid box
    38944206       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
    38954208       
    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
    39034219 
    39044220       gu = 2.0_wp * u_gtrans
    39054221       gv = 2.0_wp * v_gtrans
    39064222
     4223#ifndef _OPENACC
    39074224!
    39084225!--    Compute the fluxes for the whole left boundary of the processor domain.
     
    39154232             ibit9  = REAL( IBITS(advc_flags_1(k,j,i-1),9,1),  KIND = wp )
    39164233
    3917              u_comp(k)                = u(k,j,i) + u(k,j,i-1) - gu
    3918              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 * (                             &
    39194236                                       ( 37.0_wp * ibit11 * adv_mom_5          &
    39204237                                    +     7.0_wp * ibit10 * adv_mom_3          &
     
    39314248                                                   )
    39324249
    3933               swap_diss_x_local_u(k,j) = - ABS( u_comp(k) ) * (                &
     4250              swap_diss_x_local_u(k,j) = - ABS( u_comp ) * (                   &
    39344251                                       ( 10.0_wp * ibit11 * adv_mom_5          &
    39354252                                    +     3.0_wp * ibit10 * adv_mom_3          &
     
    39504267          DO  k = nzb_max+1, nzt
    39514268
    3952              u_comp(k)         = u(k,j,i) + u(k,j,i-1) - gu
    3953              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 * (                             &
    39544271                             37.0_wp * ( u(k,j,i) + u(k,j,i-1)   )             &
    39554272                           -  8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) )             &
    39564273                           +           ( 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) * (                      &
    39584275                             10.0_wp * ( u(k,j,i) - u(k,j,i-1)   )             &
    39594276                           -  5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) )             &
     
    39624279          ENDDO
    39634280       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)
    39654300       DO i = nxlu, nxr
     4301#ifndef _OPENACC
    39664302!       
    39674303!--       The following loop computes the fluxes for the south boundary points
     
    40194355
    40204356          ENDDO
     4357#endif
     4358
    40214359!
    40224360!--       Computation of interior fluxes and tendency terms
    40234361          DO  j = nys, nyn
    40244362
    4025              flux_t(0) = 0.0_wp
    4026              diss_t(0) = 0.0_wp
    40274363             flux_d    = 0.0_wp
    40284364             diss_d    = 0.0_wp
     
    40344370                ibit9  = REAL( IBITS(advc_flags_1(k,j,i),9,1),  KIND = wp )
    40354371
    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 ) * (                                 &
    40384374                          ( 37.0_wp * ibit11 * adv_mom_5                     &
    40394375                       +     7.0_wp * ibit10 * adv_mom_3                     &
     
    40504386                                                 )
    40514387
    4052                 diss_r(k) = - ABS( u_comp(k) - gu ) * (                      &
     4388                diss_r = - ABS( u_comp - gu ) * (                            &
    40534389                          ( 10.0_wp * ibit11 * adv_mom_5                     &
    40544390                       +     3.0_wp * ibit10 * adv_mom_3                     &
     
    40654401                                                     )
    40664402
     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
    40674445                ibit14 = REAL( IBITS(advc_flags_1(k,j,i),14,1), KIND = wp )
    40684446                ibit13 = REAL( IBITS(advc_flags_1(k,j,i),13,1), KIND = wp )
    40694447                ibit12 = REAL( IBITS(advc_flags_1(k,j,i),12,1), KIND = wp )
    40704448
    4071                 v_comp    = v(k,j+1,i) + v(k,j+1,i-1) - gv
    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 * (                                          &
    40734451                          ( 37.0_wp * ibit14 * adv_mom_5                     &
    40744452                       +     7.0_wp * ibit13 * adv_mom_3                     &
     
    40854463                                                 )
    40864464
    4087                 diss_n(k) = - ABS ( v_comp ) * (                             &
     4465                diss_n = - ABS ( v_comp ) * (                                &
    40884466                          ( 10.0_wp * ibit14 * adv_mom_5                     &
    40894467                       +     3.0_wp * ibit13 * adv_mom_3                     &
     
    40994477                                 ( u(k,j+3,i) - u(k,j-2,i) )                 &
    41004478                                                      )
     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
    41014522!
    41024523!--             k index has to be modified near bottom and top, else array
     
    41104531                k_mm  = k - 2 * ibit17
    41114532
    4112                 w_comp    = w(k,j,i) + w(k,j,i-1)
    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) * (                          &
    41144535                          ( 37.0_wp * ibit17 * adv_mom_5                     &
    41154536                       +     7.0_wp * ibit16 * adv_mom_3                     &
     
    41264547                                      )
    41274548
    4128                 diss_t(k) = - ABS( w_comp ) * rho_air_zw(k) * (              &
     4549                diss_t = - ABS( w_comp ) * rho_air_zw(k) * (                 &
    41294550                          ( 10.0_wp * ibit17 * adv_mom_5                     &
    41304551                       +     3.0_wp * ibit16 * adv_mom_3                     &
     
    41444565!--             correction is needed to overcome numerical instabilities caused
    41454566!--             by a not sufficient reduction of divergences near topography.
    4146                 div = ( ( u_comp(k) * ( ibit9 + ibit10 + ibit11 )             &
     4567                div = ( ( u_comp * ( ibit9 + ibit10 + ibit11 )                &
    41474568                - ( u(k,j,i)   + u(k,j,i-1)   )                               &
    41484569                                    * (                                       &
     
    41734594
    41744595                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)               &
    41824602                                           ) + div * u(k,j,i)
    41834603
    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
    41904612!
    41914613!--             Statistical Evaluation of u'u'. The factor has to be applied
    41924614!--             for right evaluation when gallilei_trans = .T. .
     4615                !$ACC ATOMIC
    41934616                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                  )     &
    42004623                  ) *   weight_substep(intermediate_timestep_count)
    42014624!
    42024625!--             Statistical Evaluation of w'u'.
     4626                !$ACC ATOMIC
    42034627                sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                    &
    4204                 + ( flux_t(k)                                                  &
     4628                + ( flux_t                                                     &
    42054629                    * ( w_comp - 2.0_wp * hom(k,1,3,0)                   )     &
    42064630                    / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              )     &
    4207                   + diss_t(k)                                                  &
     4631                  + diss_t                                                     &
    42084632                    *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              )     &
    42094633                    / ( ABS( w_comp ) + 1.0E-20_wp                       )     &
     
    42144638             DO  k = nzb_max+1, nzt
    42154639
    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 ) * (                                  &
    42184642                         37.0_wp * ( u(k,j,i+1) + u(k,j,i)   )                   &
    42194643                       -  8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) )                   &
    42204644                       +           ( 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 ) * (                             &
    42224646                         10.0_wp * ( u(k,j,i+1) - u(k,j,i)   )                   &
    42234647                       -  5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) )                   &
    42244648                       +           ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5
    42254649
    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 * (                                           &
    42284669                         37.0_wp * ( u(k,j+1,i) + u(k,j,i)   )                   &
    42294670                       -  8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) )                   &
    42304671                       +           ( 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 ) * (                                  &
    42324673                         10.0_wp * ( u(k,j+1,i) - u(k,j,i)   )                   &
    42334674                       -  5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) )                   &
    42344675                       +           ( 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
    42354694!
    42364695!--             k index has to be modified near bottom and top, else array
     
    42444703                k_mm  = k - 2 * ibit17
    42454704
    4246                 w_comp    = w(k,j,i) + w(k,j,i-1)
    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) * (                          &
    42484707                          ( 37.0_wp * ibit17 * adv_mom_5                        &
    42494708                       +     7.0_wp * ibit16 * adv_mom_3                        &
     
    42604719                                      )
    42614720
    4262                 diss_t(k) = - ABS( w_comp ) * rho_air_zw(k) * (              &
     4721                diss_t = - ABS( w_comp ) * rho_air_zw(k) * (                 &
    42634722                          ( 10.0_wp * ibit17 * adv_mom_5                        &
    42644723                       +     3.0_wp * ibit16 * adv_mom_3                        &
     
    42784737!--             correction is needed to overcome numerical instabilities caused
    42794738!--             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 &
    42814740                     +  ( v_comp + gv - ( v(k,j,i)   + v(k,j,i-1 )  ) ) * ddy &
    42824741                     +  (   w_comp                      * rho_air_zw(k) -     &
     
    42864745
    42874746                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)               &
    42954753                                           ) + div * u(k,j,i)
    42964754
    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
    43034763!
    43044764!--             Statistical Evaluation of u'u'. The factor has to be applied
    43054765!--             for right evaluation when gallilei_trans = .T. .
     4766                !$ACC ATOMIC
    43064767                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                  )     &
    43134774                  ) *   weight_substep(intermediate_timestep_count)
    43144775!
    43154776!--             Statistical Evaluation of w'u'.
     4777                !$ACC ATOMIC
    43164778                sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn)                    &
    4317                 + ( flux_t(k)                                                  &
     4779                + ( flux_t                                                     &
    43184780                    * ( w_comp - 2.0_wp * hom(k,1,3,0)                   )     &
    43194781                    / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              )     &
    4320                   + diss_t(k)                                                  &
     4782                  + diss_t                                                     &
    43214783                    *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              )     &
    43224784                    / ( ABS( w_comp ) + 1.0E-20_wp                       )     &
     
    43694831       REAL(wp)    ::  ibit19 !< flag indicating 3rd-order scheme along x-direction
    43704832       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
    43714838       REAL(wp)    ::  ibit21 !< flag indicating 1st-order scheme along y-direction
    43724839       REAL(wp)    ::  ibit22 !< flag indicating 3rd-order scheme along y-direction
    43734840       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
    43744846       REAL(wp)    ::  ibit24 !< flag indicating 1st-order scheme along z-direction
    43754847       REAL(wp)    ::  ibit25 !< flag indicating 3rd-order scheme along z-direction
     
    43814853       REAL(wp)    ::  gv     !< Galilei-transformation velocity along y
    43824854       REAL(wp)    ::  u_comp !< advection velocity along x
     4855#ifdef _OPENACC
     4856       REAL(wp)    ::  u_comp_l !< advection velocity along x
     4857#endif
    43834858       REAL(wp)    ::  w_comp !< advection velocity along z
    43844859       
     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
    43854863       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_diss_y_local_v !< discretized artificial dissipation at southward-side of the grid box
    43864864       REAL(wp), DIMENSION(nzb+1:nzt) ::  swap_flux_y_local_v !< discretized 6th-order flux at southward-side of the grid box
     4865#endif
    43874866       
     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
    43884870       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_v !< discretized artificial dissipation at leftward-side of the grid box
    43894871       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
    43904873       
    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
    43984884
    43994885       gu = 2.0_wp * u_gtrans
    44004886       gv = 2.0_wp * v_gtrans
     4887
     4888#ifndef _OPENACC
    44014889!
    44024890!--    First compute the whole left boundary of the processor domain
     
    44574945
    44584946       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)
    44604966       DO i = nxl, nxr
    44614967
     4968#ifndef _OPENACC
    44624969          j = nysv
    44634970          DO  k = nzb+1, nzb_max
     
    44674974             ibit21 = REAL( IBITS(advc_flags_1(k,j-1,i),21,1), KIND = wp )
    44684975
    4469              v_comp(k)              = v(k,j,i) + v(k,j-1,i) - gv
    4470              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 * (                              &
    44714978                                   ( 37.0_wp * ibit23 * adv_mom_5                &
    44724979                                +     7.0_wp * ibit22 * adv_mom_3                &
     
    44834990                                                 )
    44844991
    4485              swap_diss_y_local_v(k) = - ABS( v_comp(k) ) * (                  &
     4992             swap_diss_y_local_v(k) = - ABS( v_comp ) * (                     &
    44864993                                   ( 10.0_wp * ibit23 * adv_mom_5                &
    44874994                                +     3.0_wp * ibit22 * adv_mom_3                &
     
    45025009          DO  k = nzb_max+1, nzt
    45035010
    4504              v_comp(k)              = v(k,j,i) + v(k,j-1,i) - gv
    4505              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 * (                              &
    45065013                           37.0_wp * ( v(k,j,i) + v(k,j-1,i)   )                 &
    45075014                         -  8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) )                 &
    45085015                         +           ( 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 ) * (                     &
    45105017                           10.0_wp * ( v(k,j,i) - v(k,j-1,i)   )                 &
    45115018                         -  5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) )                 &
     
    45135020
    45145021          ENDDO
     5022#endif
    45155023
    45165024          DO  j = nysv, nyn
    45175025
    4518              flux_t(0) = 0.0_wp
    4519              diss_t(0) = 0.0_wp
    45205026             flux_d    = 0.0_wp
    45215027             diss_d    = 0.0_wp
     
    45275033                ibit18 = REAL( IBITS(advc_flags_1(k,j,i),18,1), KIND = wp )
    45285034
    4529                 u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
    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 * (                                          &
    45315037                          ( 37.0_wp * ibit20 * adv_mom_5                        &
    45325038                       +     7.0_wp * ibit19 * adv_mom_3                        &
     
    45435049                                     )
    45445050
    4545                 diss_r(k) = - ABS( u_comp ) * (                              &
     5051                diss_r = - ABS( u_comp ) * (                                 &
    45465052                          ( 10.0_wp * ibit20 * adv_mom_5                        &
    45475053                       +     3.0_wp * ibit19 * adv_mom_3                        &
     
    45585064                                              )
    45595065
     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
    45605108                ibit23 = REAL( IBITS(advc_flags_1(k,j,i),23,1), KIND = wp )
    45615109                ibit22 = REAL( IBITS(advc_flags_1(k,j,i),22,1), KIND = wp )
    45625110                ibit21 = REAL( IBITS(advc_flags_1(k,j,i),21,1), KIND = wp )
    45635111
    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 ) * (                                 &
    45665114                          ( 37.0_wp * ibit23 * adv_mom_5                        &
    45675115                       +     7.0_wp * ibit22 * adv_mom_3                        &
     
    45785126                                     )
    45795127
    4580                 diss_n(k) = - ABS( v_comp(k) - gv ) * (                      &
     5128                diss_n = - ABS( v_comp - gv ) * (                            &
    45815129                          ( 10.0_wp * ibit23 * adv_mom_5                        &
    45825130                       +     3.0_wp * ibit22 * adv_mom_3                        &
     
    45925140                                 ( v(k,j+3,i) - v(k,j-2,i) )                 &
    45935141                                                      )
     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
    45945185!
    45955186!--             k index has to be modified near bottom and top, else array
     
    46035194                k_mm  = k - 2 * ibit26
    46045195
    4605                 w_comp    = w(k,j-1,i) + w(k,j,i)
    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) * (                          &
    46075198                          ( 37.0_wp * ibit26 * adv_mom_5                        &
    46085199                       +     7.0_wp * ibit25 * adv_mom_3                        &
     
    46195210                                      )
    46205211
    4621                 diss_t(k) = - ABS( w_comp ) * rho_air_zw(k) * (              &
     5212                diss_t = - ABS( w_comp ) * rho_air_zw(k) * (                 &
    46225213                          ( 10.0_wp * ibit26 * adv_mom_5                        &
    46235214                       +     3.0_wp * ibit25 * adv_mom_3                        &
     
    46465237                                         )                                    &
    46475238                  ) * ddx                                                     &
    4648                +  ( v_comp(k)                                                 &
     5239               +  ( v_comp                                                    &
    46495240                                       * ( ibit21 + ibit22 + ibit23 )         &
    46505241                - ( v(k,j,i)     + v(k,j-1,i) )                               &
     
    46685259
    46695260                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)        &
    46795267                                            )  + v(k,j,i) * div
    46805268
    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
    46875277
    46885278!
    46895279!--             Statistical Evaluation of v'v'. The factor has to be applied
    46905280!--             for right evaluation when gallilei_trans = .T. .
     5281                !$ACC ATOMIC
    46915282                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                  )     &
    46985289                  ) *   weight_substep(intermediate_timestep_count)
    46995290!
    47005291!--             Statistical Evaluation of w'u'.
     5292                !$ACC ATOMIC
    47015293                sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                    &
    4702                 + ( flux_t(k)                                                  &
     5294                + ( flux_t                                                     &
    47035295                    * ( w_comp - 2.0_wp * hom(k,1,3,0)                   )     &
    47045296                    / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              )     &
    4705                +   diss_t(k)                                                   &
     5297               +   diss_t                                                      &
    47065298                    *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              )     &
    47075299                    / ( ABS( w_comp ) + 1.0E-20_wp                       )     &
     
    47125304             DO  k = nzb_max+1, nzt
    47135305
    4714                 u_comp    = u(k,j-1,i+1) + u(k,j,i+1) - gu
    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 * (                                           &
    47165308                      37.0_wp * ( v(k,j,i+1) + v(k,j,i)   )                      &
    47175309                    -  8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) )                      &
    47185310                    +           ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5
    47195311
    4720                 diss_r(k) = - ABS( u_comp ) * (                               &
     5312                diss_r = - ABS( u_comp ) * (                                  &
    47215313                      10.0_wp * ( v(k,j,i+1) - v(k,j,i) )                        &
    47225314                    -  5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) )                      &
    47235315                    +           ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5
    47245316
    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 ) * (                                  &
    47285336                      37.0_wp * ( v(k,j+1,i) + v(k,j,i)   )                      &
    47295337                    -  8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) )                      &
    47305338                      +         ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5
    47315339
    4732                 diss_n(k) = - ABS( v_comp(k) - gv ) * (                       &
     5340                diss_n = - ABS( v_comp - gv ) * (                             &
    47335341                      10.0_wp * ( v(k,j+1,i) - v(k,j,i)   )                      &
    47345342                    -  5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) )                      &
    47355343                    +           ( 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
    47365362!
    47375363!--             k index has to be modified near bottom and top, else array
     
    47455371                k_mm  = k - 2 * ibit26
    47465372
    4747                 w_comp    = w(k,j-1,i) + w(k,j,i)
    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) * (                          &
    47495375                          ( 37.0_wp * ibit26 * adv_mom_5                        &
    47505376                       +     7.0_wp * ibit25 * adv_mom_3                        &
     
    47615387                                      )
    47625388
    4763                 diss_t(k) = - ABS( w_comp ) * rho_air_zw(k) * (              &
     5389                diss_t = - ABS( w_comp ) * rho_air_zw(k) * (                 &
    47645390                          ( 10.0_wp * ibit26 * adv_mom_5                        &
    47655391                       +     3.0_wp * ibit25 * adv_mom_3                        &
     
    47805406!--             by a not sufficient reduction of divergences near topography.
    47815407                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 &
    47835409                     +  (   w_comp                      * rho_air_zw(k) -     &
    47845410                          ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1)     &
     
    47875413 
    47885414                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)        &
    47985421                                            )  + v(k,j,i) * div
    47995422
    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
    48065431
    48075432!
    48085433!--             Statistical Evaluation of v'v'. The factor has to be applied
    48095434!--             for right evaluation when gallilei_trans = .T. .
     5435                !$ACC ATOMIC
    48105436                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                  )     &
    48175443                  ) *   weight_substep(intermediate_timestep_count)
    48185444!
    48195445!--             Statistical Evaluation of w'u'.
     5446                !$ACC ATOMIC
    48205447                sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn)                    &
    4821                 + ( flux_t(k)                                                  &
     5448                + ( flux_t                                                     &
    48225449                    * ( w_comp - 2.0_wp * hom(k,1,3,0)                   )     &
    48235450                    / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              )     &
    4824                +   diss_t(k)                                                   &
     5451               +   diss_t                                                      &
    48255452                    *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              )     &
    48265453                    / ( ABS( w_comp ) + 1.0E-20_wp                       )     &
     
    48305457          ENDDO
    48315458       ENDDO
     5459!$ACC UPDATE HOST(sums_vs2_ws_l(nzb+1,tn))
    48325460       sums_vs2_ws_l(nzb,tn) = sums_vs2_ws_l(nzb+1,tn)
     5461!$ACC UPDATE DEVICE(sums_vs2_ws_l(nzb,tn))
    48335462
    48345463
     
    48745503       REAL(wp)    ::  ibit28 !< flag indicating 3rd-order scheme along x-direction
    48755504       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
    48765510       REAL(wp)    ::  ibit30 !< flag indicating 1st-order scheme along y-direction
    48775511       REAL(wp)    ::  ibit31 !< flag indicating 3rd-order scheme along y-direction
    48785512       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
    48795518       REAL(wp)    ::  ibit33 !< flag indicating 1st-order scheme along z-direction
    48805519       REAL(wp)    ::  ibit34 !< flag indicating 3rd-order scheme along z-direction
     
    48865525       REAL(wp)    ::  gv     !< Galilei-transformation velocity along y
    48875526       REAL(wp)    ::  u_comp !< advection velocity along x
     5527#ifdef _OPENACC
     5528       REAL(wp)    ::  u_comp_l !< advection velocity along x
     5529#endif
    48885530       REAL(wp)    ::  v_comp !< advection velocity along y
     5531#ifdef _OPENACC
     5532       REAL(wp)    ::  v_comp_s !< advection velocity along y
     5533#endif
    48895534       REAL(wp)    ::  w_comp !< advection velocity along z
    48905535       
    4891        REAL(wp), DIMENSION(nzb:nzt)    ::  diss_t !< discretized artificial dissipation at top of the grid box
    4892        REAL(wp), DIMENSION(nzb:nzt)    ::  flux_t !< discretized 6th-order flux at top of the grid box
     5536       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
    48935538       
    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
    48985547       REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_diss_y_local_w !< discretized artificial dissipation at southward-side of the grid box
    48995548       REAL(wp), DIMENSION(nzb+1:nzt)  ::  swap_flux_y_local_w !< discretized 6th-order flux at southward-side of the grid box
     5549#endif
    49005550       
     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
    49015554       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  swap_diss_x_local_w !< discretized artificial dissipation at leftward-side of the grid box
    49025555       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
    49035557 
    49045558       gu = 2.0_wp * u_gtrans
    49055559       gv = 2.0_wp * v_gtrans
     5560
     5561#ifndef _OPENACC
    49065562!
    49075563!--   compute the whole left boundary of the processor domain
     
    49625618
    49635619       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))
    49655639       DO i = nxl, nxr
    49665640
     5641#ifndef _OPENACC
    49675642          j = nys
    49685643          DO  k = nzb+1, nzb_max
     
    50185693
    50195694          ENDDO
     5695#endif
    50205696
    50215697          DO  j = nys, nyn
     
    50255701!--          at the first w-level. For topography wall this is done implicitely
    50265702!--          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
    50335707
    50345708             DO  k = nzb+1, nzb_max
     
    50385712                ibit27 = REAL( IBITS(advc_flags_1(k,j,i),27,1), KIND = wp )
    50395713
    5040                 u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
    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 * (                                          &
    50425716                          ( 37.0_wp * ibit29 * adv_mom_5                        &
    50435717                       +     7.0_wp * ibit28 * adv_mom_3                        &
     
    50545728                                     )
    50555729
    5056                 diss_r(k) = - ABS( u_comp ) * (                              &
     5730                diss_r = - ABS( u_comp ) * (                                 &
    50575731                          ( 10.0_wp * ibit29 * adv_mom_5                        &
    50585732                       +     3.0_wp * ibit28 * adv_mom_3                        &
     
    50695743                                              )
    50705744
     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
    50715788                ibit32 = REAL( IBITS(advc_flags_2(k,j,i),0,1),  KIND = wp )
    50725789                ibit31 = REAL( IBITS(advc_flags_1(k,j,i),31,1), KIND = wp )
    50735790                ibit30 = REAL( IBITS(advc_flags_1(k,j,i),30,1), KIND = wp )
    50745791
    5075                 v_comp    = v(k+1,j+1,i) + v(k,j+1,i) - gv
    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 * (                                          &
    50775794                          ( 37.0_wp * ibit32 * adv_mom_5                        &
    50785795                       +     7.0_wp * ibit31 * adv_mom_3                        &
     
    50895806                                     )
    50905807
    5091                 diss_n(k) = - ABS( v_comp ) * (                              &
     5808                diss_n = - ABS( v_comp ) * (                                 &
    50925809                          ( 10.0_wp * ibit32 * adv_mom_5                        &
    50935810                       +     3.0_wp * ibit31 * adv_mom_3                        &
     
    51035820                                 ( w(k,j+3,i) - w(k,j-2,i) )                 &
    51045821                                              )
     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
    51055865!
    51065866!--             k index has to be modified near bottom and top, else array
     
    51145874                k_mm  = k - 2 * ibit35
    51155875
    5116                 w_comp    = w(k+1,j,i) + w(k,j,i)
    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) * (                           &
    51185878                          ( 37.0_wp * ibit35 * adv_mom_5                        &
    51195879                       +     7.0_wp * ibit34 * adv_mom_3                        &
     
    51305890                                       )
    51315891
    5132                 diss_t(k) = - ABS( w_comp ) * rho_air(k+1) * (               &
     5892                diss_t = - ABS( w_comp ) * rho_air(k+1) * (                  &
    51335893                          ( 10.0_wp * ibit35 * adv_mom_5                        &
    51345894                       +     3.0_wp * ibit34 * adv_mom_3                        &
     
    51775937
    51785938                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)    &
    51885945                                            )  + div * w(k,j,i)
    51895946
    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
    51975957                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
    5198                       + ( flux_t(k)                                           &
     5958                      + ( flux_t                                              &
    51995959                       * ( w_comp - 2.0_wp * hom(k,1,3,0)                   ) &
    52005960                       / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              ) &
    5201                         + diss_t(k)                                           &
     5961                        + diss_t                                              &
    52025962                       *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              ) &
    52035963                       / ( ABS( w_comp ) + 1.0E-20_wp                       ) &
     
    52085968             DO  k = nzb_max+1, nzt
    52095969
    5210                 u_comp    = u(k+1,j,i+1) + u(k,j,i+1) - gu
    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 * (                                         &
    52125972                      37.0_wp * ( w(k,j,i+1) + w(k,j,i)   )                    &
    52135973                    -  8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) )                    &
    52145974                    +           ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5
    52155975
    5216                 diss_r(k) = - ABS( u_comp ) * (                             &
     5976                diss_r = - ABS( u_comp ) * (                                &
    52175977                      10.0_wp * ( w(k,j,i+1) - w(k,j,i)   )                    &
    52185978                    -  5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) )                    &
    52195979                    +           ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5
    52205980
    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 * (                                         &
    52236000                      37.0_wp * ( w(k,j+1,i) + w(k,j,i)   )                    &
    52246001                    -  8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) )                    &
    52256002                    +           ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5
    52266003
    5227                 diss_n(k) = - ABS( v_comp ) * (                             &
     6004                diss_n = - ABS( v_comp ) * (                                &
    52286005                      10.0_wp * ( w(k,j+1,i) - w(k,j,i)   )                    &
    52296006                    -  5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) )                    &
    52306007                    +           ( 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
    52316026!
    52326027!--             k index has to be modified near bottom and top, else array
     
    52406035                k_mm  = k - 2 * ibit35
    52416036
    5242                 w_comp    = w(k+1,j,i) + w(k,j,i)
    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) * (                           &
    52446039                          ( 37.0_wp * ibit35 * adv_mom_5                        &
    52456040                       +     7.0_wp * ibit34 * adv_mom_3                        &
     
    52566051                                       )
    52576052
    5258                 diss_t(k) = - ABS( w_comp ) * rho_air(k+1) * (               &
     6053                diss_t = - ABS( w_comp ) * rho_air(k+1) * (                  &
    52596054                          ( 10.0_wp * ibit35 * adv_mom_5                        &
    52606055                       +     3.0_wp * ibit34 * adv_mom_3                        &
     
    52826077
    52836078                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)    &
    52936085                                            )  + div * w(k,j,i)
    52946086
    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
    53026097                sums_ws2_ws_l(k,tn)  = sums_ws2_ws_l(k,tn)                    &
    5303                       + ( flux_t(k)                                           &
     6098                      + ( flux_t                                              &
    53046099                       * ( w_comp - 2.0_wp * hom(k,1,3,0)                   ) &
    53056100                       / ( w_comp + SIGN( 1.0E-20_wp, w_comp )              ) &
    5306                         + diss_t(k)                                           &
     6101                        + diss_t                                              &
    53076102                       *   ABS( w_comp - 2.0_wp * hom(k,1,3,0)              ) &
    53086103                       / ( ABS( w_comp ) + 1.0E-20_wp                       ) &
  • palm/trunk/SOURCE/basic_constants_and_equations_mod.f90

    r3449 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3449 2018-10-29 19:36:56Z suehring
    2730! +degc_to_k
    2831!
     
    5861    REAL(wp), PARAMETER ::  molecular_weight_of_water = 0.01801528_wp !< mol. m. H2O (kg mol-1)
    5962    REAL(wp), PARAMETER ::  pi = 3.141592654_wp                       !< PI
     63    !$ACC DECLARE COPYIN(pi)
    6064    REAL(wp), PARAMETER ::  rho_l = 1.0E3_wp                          !< density of water (kg m-3)
    6165    REAL(wp), PARAMETER ::  rho_nacl = 2165.0_wp                      !< density of NaCl (kg m-3)
  • palm/trunk/SOURCE/boundary_conds.f90

    r3589 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3589 2018-11-30 15:09:51Z suehring
    2730! Move the control parameter "salsa" from salsa_mod to control_parameters
    2831! (M. Kurppa)
     
    289292       kb = MERGE( -1, 1, l == 0 )
    290293       !$OMP PARALLEL DO PRIVATE( i, j, k )
     294       !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
     295       !$ACC PRESENT(bc_h, w_p)
    291296       DO  m = 1, bc_h(l)%ns
    292297          i = bc_h(l)%i(m)           
     
    300305!-- Top boundary. A nested domain ( ibc_uv_t = 3 ) does not require settings.
    301306    IF ( ibc_uv_t == 0 )  THEN
     307        !$ACC KERNELS PRESENT(u_p, v_p, u_init, v_init)
    302308        u_p(nzt+1,:,:) = u_init(nzt+1)
    303309        v_p(nzt+1,:,:) = v_init(nzt+1)
     310        !$ACC END KERNELS
    304311    ELSEIF ( ibc_uv_t == 1 )  THEN
    305312        u_p(nzt+1,:,:) = u_p(nzt,:,:)
     
    311318    IF (  .NOT.  child_domain  .AND.  .NOT.  nesting_offline  .AND.            &
    312319                 TRIM(coupling_mode) /= 'vnested_fine' )  THEN
     320       !$ACC KERNELS PRESENT(w_p)
    313321       w_p(nzt:nzt+1,:,:) = 0.0_wp  !< nzt is not a prognostic level (but cf. pres)
     322       !$ACC END KERNELS
    314323    ENDIF
    315324
     
    342351          kb = MERGE( -1, 1, l == 0 )
    343352          !$OMP PARALLEL DO PRIVATE( i, j, k )
     353          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
     354          !$ACC PRESENT(bc_h, pt_p)
    344355          DO  m = 1, bc_h(l)%ns
    345356             i = bc_h(l)%i(m)           
     
    364375        pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
    365376    ELSEIF ( ibc_pt_t == 2 )  THEN
     377        !$ACC KERNELS PRESENT(pt_p, dzu)
    366378        pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1)
     379        !$ACC END KERNELS
    367380    ENDIF
    368381
     
    379392             kb = MERGE( -1, 1, l == 0 )
    380393             !$OMP PARALLEL DO PRIVATE( i, j, k )
     394             !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
     395             !$ACC PRESENT(bc_h, e_p)
    381396             DO  m = 1, bc_h(l)%ns
    382397                i = bc_h(l)%i(m)           
     
    444459
    445460       IF ( .NOT. child_domain )  THEN
     461          !$ACC KERNELS PRESENT(e_p)
    446462          e_p(nzt+1,:,:) = e_p(nzt,:,:)
     463          !$ACC END KERNELS
    447464!
    448465!--    Nesting case: if parent operates in RANS mode and child in LES mode,
  • palm/trunk/SOURCE/buoyancy.f90

    r3538 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3538 2018-11-20 10:55:41Z suehring
    2730! Remove unnecessary double-masking of topography
    2831!
     
    175178!
    176179!--       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)
    177184          DO  i = nxl, nxr
    178185             DO  j = nys, nyn
  • palm/trunk/SOURCE/coriolis.f90

    r3538 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3538 2018-11-20 10:55:41Z suehring
    2730! Note concerning topography masking added
    2831!
     
    145148!--       u-component
    146149          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)
    147154             DO  i = nxlu, nxr
    148155                DO  j = nys, nyn
     
    167174!--       v-component
    168175          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)
    169180             DO  i = nxl, nxr
    170181                DO  j = nysv, nyn
     
    185196!--       w-component
    186197          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)
    187202             DO  i = nxl, nxr
    188203                DO  j = nys, nyn
  • palm/trunk/SOURCE/diffusion_s.f90

    r3547 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3547 2018-11-21 13:21:24Z suehring
    2730! variables documented
    2831!
     
    194197#endif
    195198
     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)
    196219       DO  i = nxl, nxr
    197220          DO  j = nys,nyn
  • palm/trunk/SOURCE/diffusion_u.f90

    r3547 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3547 2018-11-21 13:21:24Z suehring
    2730! variables documented
    2831!
     
    172175
    173176
     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)
    174187       DO  i = nxlu, nxr
    175188          DO  j = nys, nyn
  • palm/trunk/SOURCE/diffusion_v.f90

    r3547 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3547 2018-11-21 13:21:24Z suehring
    2730! variables documented
    2831!
     
    165168       REAL(wp)     ::  mask_top      !< flag to mask vertical downward-facing surface     
    166169
     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)
    167180       DO  i = nxl, nxr
    168181          DO  j = nysv, nyn
  • palm/trunk/SOURCE/diffusion_w.f90

    r3547 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3547 2018-11-21 13:21:24Z suehring
    2730! variables documented
    2831!
     
    166169
    167170
     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)
    168181       DO  i = nxl, nxr
    169182          DO  j = nys, nyn
  • palm/trunk/SOURCE/exchange_horiz.f90

    r3241 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3241 2018-09-12 15:02:00Z raasch
    2730! unused variables removed
    2831!
     
    117120
    118121
     122#ifdef _OPENACC
     123    INTEGER(iwp) ::  i           !<
     124#endif
    119125    INTEGER(iwp) ::  nbgp_local  !<
    120126   
     
    124130
    125131    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
    126143
    127144#if defined( __parallel )
     
    263280
    264281#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
    265294    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
    266295
  • palm/trunk/SOURCE/fft_xy_mod.f90

    r3241 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3241 2018-09-12 15:02:00Z raasch
    2730! preprocessor switches for variables that are required on NEC only
    2831!
     
    156159        ONLY:  fft_method, message_string
    157160       
     161    USE cuda_fft_interfaces
     162       
    158163    USE indices,                                                               &
    159164        ONLY:  nx, ny, nz
    160165       
    161 #if defined( __fftw )
     166#if defined( __cuda_fft )
     167    USE ISO_C_BINDING
     168#elif defined( __fftw )
    162169    USE, INTRINSIC ::  ISO_C_BINDING
    163170#endif
     
    210217    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  trig_yf  !<
    211218   
     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
    212225#endif
    213226
     
    298311       ENDIF
    299312
     313#if defined( _OPENACC ) && defined( __cuda_fft )
     314       fft_method = 'system-specific'
     315#endif
     316
    300317       IF ( fft_method == 'system-specific' )  THEN
    301318
     
    346363          CALL ZDFFTM( 0, ny+1, nz1, sqr_dny, work_y, ny+4, work_y, ny+4,      &
    347364                       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) )
    348370#else
    349371          message_string = 'no system-specific fft-call available'
     
    425447#elif defined( __nec )
    426448       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)
    427453#endif
    428454
     
    726752             ENDDO
    727753             !$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
    728803
    729804          ENDIF
     
    10011076#elif defined( __nec )
    10021077       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)
    10031082#endif
    10041083
     
    12781357
    12791358          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
    12801408#endif
    12811409
  • palm/trunk/SOURCE/poisfft_mod.f90

    r3241 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3241 2018-09-12 15:02:00Z raasch
    2730! unused variables removed,
    2831! declarations of omp_get_thread_num now as omp-directive
     
    250253       REAL(wp), DIMENSION(1:nz,nys:nyn,nxl:nxr) ::  ar      !<
    251254       REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nz) ::  ar_inv  !<
     255       !$ACC DECLARE CREATE(ar_inv)
    252256
    253257       REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  ar1      !<
     
    262266       IF ( .NOT. poisfft_initialized )  CALL poisfft_init
    263267
     268#ifndef _OPENACC
    264269!
    265270!--    Two-dimensional Fourier Transformation in x- and y-direction.
     
    295300
    296301       ELSEIF ( .NOT. transpose_compute_overlap )  THEN
     302#endif
    297303
    298304!
     
    366372          CALL cpu_log( log_point_s(8), 'transpo invers', 'stop' )
    367373
     374#ifndef _OPENACC
    368375       ELSE
    369376
     
    698705
    699706       ENDIF
     707#endif
    700708
    701709       CALL cpu_log( log_point_s(3), 'poisfft', 'stop' )
  • palm/trunk/SOURCE/pres.f90

    r3347 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3347 2018-10-15 14:21:08Z suehring
    2730! Bugfixes in offline nesting.
    2831! Add comment.
     
    232235
    233236    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))
    234250
    235251
     
    442458    ELSE
    443459       !$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE (i,j,k)
     460       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     461       !$ACC PRESENT(d)
    444462       DO  i = nxl, nxr
    445463          DO  j = nys, nyn
     
    490508    !$OMP PARALLEL PRIVATE (i,j,k)
    491509    !$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)
    492513    DO  i = nxl, nxr
    493514       DO  j = nys, nyn
     
    513534       !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
    514535       !$OMP DO SCHEDULE( STATIC )
     536       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     537       !$ACC REDUCTION(+:threadsum) COPY(threadsum) &
     538       !$ACC PRESENT(d)
    515539       DO  i = nxl, nxr
    516540          DO  j = nys, nyn
     
    547571!--    z-direction
    548572       !$OMP PARALLEL DO PRIVATE (i,j,k)
     573       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     574       !$ACC PRESENT(d, tend)
    549575       DO  i = nxl, nxr
    550576          DO  j = nys, nyn
     
    565591!--       Upward facing
    566592          !$OMP PARALLEL DO PRIVATE( i, j, k )
     593          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
     594          !$ACC PRESENT(bc_h, tend)
    567595          DO  m = 1, bc_h(0)%ns
    568596             i = bc_h(0)%i(m)
     
    574602!--       Downward facing
    575603          !$OMP PARALLEL DO PRIVATE( i, j, k )
     604          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
     605          !$ACC PRESENT(bc_h, tend)
    576606          DO  m = 1, bc_h(1)%ns
    577607             i = bc_h(1)%i(m)
     
    621651!--       Dirichlet
    622652          !$OMP PARALLEL DO PRIVATE (i,j,k)
     653          !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) &
     654          !$ACC PRESENT(tend)
    623655          DO  i = nxlg, nxrg
    624656             DO  j = nysg, nyng
     
    688720       !$OMP PARALLEL PRIVATE (i,j,k)
    689721       !$OMP DO
     722       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     723       !$ACC PRESENT(p, tend)
    690724       DO  i = nxl-1, nxr+1
    691725          DO  j = nys-1, nyn+1
     
    701735       !$OMP PARALLEL PRIVATE (i,j,k)
    702736       !$OMP DO
     737       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     738       !$ACC PRESENT(p, tend)
    703739       DO  i = nxl-1, nxr+1
    704740          DO  j = nys-1, nyn+1
     
    733769    !$OMP PARALLEL PRIVATE (i,j,k)
    734770    !$OMP DO
     771    !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k) &
     772    !$ACC PRESENT(u, v, w, tend, ddzu, wall_flags_0)
    735773    DO  i = nxl, nxr   
    736774       DO  j = nys, nyn
     
    900938#else
    901939       !$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)
    902943       DO  i = nxl, nxr
    903944          DO  j = nys, nyn
     
    916957!--    Compute possible PE-sum of divergences for flow_statistics
    917958       !$OMP DO SCHEDULE( STATIC )
     959       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     960       !$ACC REDUCTION(+:threadsum) COPY(threadsum) &
     961       !$ACC PRESENT(d)
    918962       DO  i = nxl, nxr
    919963          DO  j = nys, nyn
     
    939983    CALL cpu_log( log_point(8), 'pres', 'stop' )
    940984
     985!$ACC END DATA
     986!$ACC END DATA
    941987
    942988 END SUBROUTINE pres
  • palm/trunk/SOURCE/prognostic_equations.f90

    r3589 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3589 2018-11-30 15:09:51Z suehring
    2730! Move the control parameter "salsa" from salsa_mod to control_parameters
    2831! (M. Kurppa)
     
    15661569    CALL cpu_log( log_point(5), 'u-equation', 'start' )
    15671570
     1571    !$ACC KERNELS PRESENT(tend)
    15681572    tend = 0.0_wp
     1573    !$ACC END KERNELS
    15691574    IF ( timestep_scheme(1:5) == 'runge' )  THEN
    15701575       IF ( ws_scheme_mom )  THEN
     
    16141619!
    16151620!-- 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)
    16161625    DO  i = nxlu, nxr
    16171626       DO  j = nys, nyn
     
    16401649    IF ( timestep_scheme(1:5) == 'runge' )  THEN
    16411650       IF ( intermediate_timestep_count == 1 )  THEN
     1651          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     1652          !$ACC PRESENT(tend, tu_m)
    16421653          DO  i = nxlu, nxr
    16431654             DO  j = nys, nyn
     
    16491660       ELSEIF ( intermediate_timestep_count < &
    16501661                intermediate_timestep_count_max )  THEN
     1662          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     1663          !$ACC PRESENT(tend, tu_m)
    16511664          DO  i = nxlu, nxr
    16521665             DO  j = nys, nyn
     
    16661679    CALL cpu_log( log_point(6), 'v-equation', 'start' )
    16671680
     1681    !$ACC KERNELS PRESENT(tend)
    16681682    tend = 0.0_wp
     1683    !$ACC END KERNELS
    16691684    IF ( timestep_scheme(1:5) == 'runge' )  THEN
    16701685       IF ( ws_scheme_mom )  THEN
     
    17111726!
    17121727!-- 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)
    17131732    DO  i = nxl, nxr
    17141733       DO  j = nysv, nyn
     
    17371756    IF ( timestep_scheme(1:5) == 'runge' )  THEN
    17381757       IF ( intermediate_timestep_count == 1 )  THEN
     1758          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     1759          !$ACC PRESENT(tend, tv_m)
    17391760          DO  i = nxl, nxr
    17401761             DO  j = nysv, nyn
     
    17461767       ELSEIF ( intermediate_timestep_count < &
    17471768                intermediate_timestep_count_max )  THEN
     1769          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     1770          !$ACC PRESENT(tend, tv_m)
    17481771          DO  i = nxl, nxr
    17491772             DO  j = nysv, nyn
     
    17631786    CALL cpu_log( log_point(7), 'w-equation', 'start' )
    17641787
     1788    !$ACC KERNELS PRESENT(tend)
    17651789    tend = 0.0_wp
     1790    !$ACC END KERNELS
    17661791    IF ( timestep_scheme(1:5) == 'runge' )  THEN
    17671792       IF ( ws_scheme_mom )  THEN
     
    18041829!
    18051830!-- 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)
    18061835    DO  i = nxl, nxr
    18071836       DO  j = nys, nyn
     
    18211850    IF ( timestep_scheme(1:5) == 'runge' )  THEN
    18221851       IF ( intermediate_timestep_count == 1 )  THEN
     1852          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     1853          !$ACC PRESENT(tend, tw_m)
    18231854          DO  i = nxl, nxr
    18241855             DO  j = nys, nyn
     
    18301861       ELSEIF ( intermediate_timestep_count < &
    18311862                intermediate_timestep_count_max )  THEN
     1863          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     1864          !$ACC PRESENT(tend, tw_m)
    18321865          DO  i = nxl, nxr
    18331866             DO  j = nys, nyn
     
    18681901!--    pt-tendency terms with no communication
    18691902       IF ( scalar_advec /= 'bc-scheme' )  THEN
     1903          !$ACC KERNELS PRESENT(tend)
    18701904          tend = 0.0_wp
     1905          !$ACC END KERNELS
    18711906          IF ( timestep_scheme(1:5) == 'runge' )  THEN
    18721907             IF ( ws_scheme_sca )  THEN
     
    19261961!
    19271962!--    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)
    19281968       DO  i = nxl, nxr
    19291969          DO  j = nys, nyn
     
    19451985       IF ( timestep_scheme(1:5) == 'runge' )  THEN
    19461986          IF ( intermediate_timestep_count == 1 )  THEN
     1987             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     1988             !$ACC PRESENT(tend, tpt_m)
    19471989             DO  i = nxl, nxr
    19481990                DO  j = nys, nyn
     
    19541996          ELSEIF ( intermediate_timestep_count < &
    19551997                   intermediate_timestep_count_max )  THEN
     1998             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     1999             !$ACC PRESENT(tend, tpt_m)
    19562000             DO  i = nxl, nxr
    19572001                DO  j = nys, nyn
  • palm/trunk/SOURCE/surface_layer_fluxes_mod.f90

    r3597 r3634  
    2626! -----------------
    2727! $Id$
     28! OpenACC port for SPEC
     29!
     30! 3597 2018-12-04 08:40:18Z maronga
    2831! Added routine for calculating near surface air potential temperature (moved
    2932! from urban_surface_mod)
     
    10091012       ibit = MERGE( 1, 0, .NOT. downward )
    10101013
     1014       !$ACC PARALLEL LOOP PRIVATE(i, j, k, w_lfc) &
     1015       !$ACC PRESENT(surf, u, v)
    10111016       DO  m = 1, surf%ns
    10121017
     
    12971302             ELSE
    12981303                !$OMP PARALLEL DO PRIVATE( k, z_mo )
     1304                !$ACC PARALLEL LOOP PRIVATE(k, z_mo) &
     1305                !$ACC PRESENT(surf, drho_air_zw)
    12991306                DO  m = 1, surf%ns
    13001307
     
    13191326       IF ( TRIM( most_method ) == 'newton' )  THEN
    13201327
     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)
    13211331          DO  m = 1, surf%ns
    13221332
     
    15751585          IF ( .NOT. downward )  THEN
    15761586             !$OMP PARALLEL  DO PRIVATE( z_mo )
     1587             !$ACC PARALLEL LOOP PRIVATE(z_mo) &
     1588             !$ACC PRESENT(surf)
    15771589             DO  m = 1, surf%ns
    15781590
     
    15911603          ELSE
    15921604             !$OMP PARALLEL  DO PRIVATE( z_mo )
     1605             !$ACC PARALLEL LOOP PRIVATE(z_mo) &
     1606             !$ACC PRESENT(surf)
    15931607             DO  m = 1, surf%ns
    15941608
     
    16051619       ELSE
    16061620          !$OMP PARALLEL DO PRIVATE( z_mo )
     1621          !$ACC PARALLEL LOOP PRIVATE(z_mo) &
     1622          !$ACC PRESENT(surf)
    16071623          DO  m = 1, surf%ns
    16081624             z_mo = surf%z_mo(m)
     
    16241640
    16251641       !$OMP PARALLEL DO PRIVATE( i, j, k )
     1642       !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
     1643       !$ACC PRESENT(surf, pt)
    16261644       DO  m = 1, surf%ns
    16271645
     
    16301648          k   = surf%k(m)
    16311649
     1650#ifndef _OPENACC
    16321651          IF ( bulk_cloud_model ) THEN
    16331652             surf%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
     
    16371656             surf%qv1(m) = q(k,j,i)
    16381657          ELSE
     1658#endif
    16391659             surf%pt1(m) = pt(k,j,i)
     1660#ifndef _OPENACC
    16401661             IF ( humidity )  THEN
    16411662                surf%qv1(m) = q(k,j,i)
    16421663             ELSE
     1664#endif
    16431665                surf%qv1(m) = 0.0_wp
     1666#ifndef _OPENACC
    16441667             ENDIF
    16451668          ENDIF
     
    16481671             surf%vpt1(m) = pt(k,j,i) * ( 1.0_wp + 0.61_wp * q(k,j,i) )
    16491672          ENDIF
     1673#endif
    16501674         
    16511675       ENDDO
     
    16581682!-- ( only for upward-facing surfs )
    16591683    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
    16601733
    16611734       IMPLICIT NONE
     
    16721745          k   = surf%k(m)
    16731746
    1674           surf%pt_surface(m) = pt(k+k_off,j,i)
    1675 
    1676        ENDDO
    1677 
    1678     END SUBROUTINE calc_pt_surface
    1679 
    1680 !
    1681 !-- Set mixing ratio at surface grid level. ( Only for upward-facing surfs. )
    1682     SUBROUTINE calc_q_surface
    1683 
    1684        IMPLICIT NONE
    1685 
    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 elements
    1688        
    1689        k_off = surf%koff
    1690        !$OMP PARALLEL DO PRIVATE( i, j, k )
    1691        DO  m = 1, surf%ns
    1692 
    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        ENDDO
    1700 
    1701     END SUBROUTINE calc_q_surface
    1702    
    1703 !
    1704 !-- Set virtual potential temperature at surface grid level.
    1705 !-- ( only for upward-facing surfs )
    1706     SUBROUTINE calc_vpt_surface
    1707 
    1708        IMPLICIT NONE
    1709 
    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 elements
    1712        
    1713        k_off = surf%koff
    1714        !$OMP PARALLEL DO PRIVATE( i, j, k )
    1715        DO  m = 1, surf%ns
    1716 
    1717           i   = surf%i(m)           
    1718           j   = surf%j(m)
    1719           k   = surf%k(m)
    1720 
    17211747          surf%vpt_surface(m) = vpt(k+k_off,j,i)
    17221748
     
    17411767
    17421768          !$OMP PARALLEL DO PRIVATE( i, j, k )
     1769          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
     1770          !$ACC PRESENT(surf, drho_air_zw)
    17431771          DO  m = 1, surf%ns
    17441772
     
    20392067          IF ( .NOT. downward )  THEN
    20402068             !$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)
    20412071             DO  m = 1, surf%ns 
    20422072   
     
    20862116          IF ( .NOT. downward )  THEN
    20872117             !$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)
    20882120             DO  m = 1, surf%ns 
    20892121                i = surf%i(m)           
     
    23922424!-- Integrated stability function for momentum
    23932425    FUNCTION psi_m( zeta )
     2426       !$ACC ROUTINE SEQ
    23942427       
    23952428       USE kinds
     
    24292462!-- Integrated stability function for heat and moisture
    24302463    FUNCTION psi_h( zeta )
     2464       !$ACC ROUTINE SEQ
    24312465       
    24322466       USE kinds
     
    24692503!------------------------------------------------------------------------------!
    24702504    FUNCTION phi_m( zeta )
     2505       !$ACC ROUTINE SEQ
    24712506   
    24722507       IMPLICIT NONE
  • palm/trunk/SOURCE/surface_mod.f90

    r3597 r3634  
    2626! -----------------
    2727! $Id$
     28! OpenACC port for SPEC
     29!
     30! 3597 2018-12-04 08:40:18Z maronga
    2831! Added pt_2m and renamed t_surf_10cm to pt_10cm. Removed some _eb variables as
    2932! they are no longer used.
     
    608611    END INTERFACE init_surface_arrays
    609612
     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
    610621    INTERFACE surface_rrd_local
    611622       MODULE PROCEDURE surface_rrd_local
     
    634645!-- Public subroutines and functions
    635646    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
    638650
    639651
     
    10841096
    10851097    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
    10861186
    10871187
     
    13281428! Description:
    13291429! ------------
     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! ------------
    13301512!> Deallocating memory for model-top fluxes 
    13311513!------------------------------------------------------------------------------!
     
    14601642
    14611643    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
    14621704
    14631705
     
    17031945
    17041946    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
    17052009
    17062010
  • palm/trunk/SOURCE/time_integration.f90

    r3597 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3597 2018-12-04 08:40:18Z maronga
    2730! Removed call to calculation of near air (10 cm) potential temperature (now in
    2831! surface layer fluxes)
     
    421424
    422425    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
    427433
    428434    USE biometeorology_mod,                                                    &
     
    479485               time_dopr_listing, time_dopts, time_dosp, time_dosp_av,         &
    480486               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,              &
    482488               turbulent_inflow, turbulent_outflow, urban_surface,             &
    483489               use_initial_profile_as_reference,                               &
     
    499505
    500506    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
    502509
    503510    USE indoor_model_mod,                                                      &
     
    556563              salsa_boundary_conds, salsa_gas, salsa_gases_from_chem,          &
    557564              skip_time_do_salsa                     
     565   
     566    USE salsa_util_mod,                                                        &
     567           ONLY:  sums_salsa_ws_l     
    558568
    559569    USE spectra_mod,                                                           &
     
    562572
    563573    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
    565580
    566581    USE surface_layer_fluxes_mod,                                              &
     
    568583
    569584    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
    571587
    572588    USE surface_output_mod,                                                    &
     
    623639    REAL(wp) ::  time_since_reference_point_save  !< original value of
    624640                                                  !< 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))
    625723
    626724!
     
    739837       ENDIF   
    740838       
     839#ifdef _OPENACC
     840       CALL enter_surface_arrays
     841#endif
     842       
    741843!
    742844!--    Start of intermediate step loop
     
    12521354
    12531355       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
    12541381!
    12551382!--    If required, consider chemical emissions
     
    16551782    ENDDO   ! time loop
    16561783
     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
    16571792!
    16581793!-- Vertical nesting: Deallocate variables initialized for vertical nesting   
  • palm/trunk/SOURCE/timestep.f90

    r3311 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3311 2018-10-05 12:34:56Z raasch
    2730! Stokes drift is regarded in timestep calculation
    2831!
     
    204207    REAL(wp), DIMENSION(3)         ::  reduce_l    !<
    205208    REAL(wp), DIMENSION(nzb+1:nzt) ::  dxyz2_min   !< 
     209    !$ACC DECLARE CREATE(dxyz2_min)
    206210
    207211
     
    277281       dt_v_l = 999999.9_wp
    278282       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)
    279287       DO  i = nxl, nxr
    280288          DO  j = nys, nyn
     
    313321       dt_diff_l = 999999.0_wp
    314322
     323       !$ACC PARALLEL LOOP PRESENT(dxyz2_min, dzw)
    315324       DO  k = nzb+1, nzt
    316325           dxyz2_min(k) = MIN( dx2, dy2, dzw(k)*dzw(k) ) * 0.125_wp
     
    319328       !$OMP PARALLEL private(i,j,k) reduction(MIN: dt_diff_l)
    320329       !$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)
    321333       DO  i = nxl, nxr
    322334          DO  j = nys, nyn
  • palm/trunk/SOURCE/timestep_scheme_steering.f90

    r2718 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 2718 2018-01-02 08:49:38Z maronga
    2730! Corrected "Former revisions" section
    2831!
     
    9093       ENDIF
    9194
     95       !$ACC UPDATE DEVICE(tsc(1:5))
     96
    9297    ELSEIF ( timestep_scheme == 'euler' )  THEN
    9398!
  • palm/trunk/SOURCE/transpose.f90

    r3241 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3241 2018-09-12 15:02:00Z raasch
    2730! unused variables removed
    2831!
     
    119122    !$OMP  PARALLEL PRIVATE ( i, j, k )
    120123    !$OMP  DO
     124     !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     125     !$ACC PRESENT(f_inv, f_in)
    121126     DO  i = 0, nx
    122127         DO  k = nzb_x, nzt_x
     
    166171
    167172    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)
    168174
    169175
     
    174180!--    Transpose array
    175181       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
     182       !$ACC UPDATE HOST(f_inv)
    176183       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    177184       CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL, &
    178185                          work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, &
    179186                          comm1dy, ierr )
     187       !$ACC UPDATE DEVICE(work)
    180188       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
    181189
     
    186194       DO  l = 0, pdims(2) - 1
    187195          ys = 0 + l * ( nyn_x - nys_x + 1 )
     196          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     197          !$ACC PRESENT(f_out, work)
    188198          DO  i = nxl_y, nxr_y
    189199             DO  k = nzb_y, nzt_y
     
    203213!$OMP  PARALLEL PRIVATE ( i, j, k )
    204214!$OMP  DO
     215       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     216       !$ACC PRESENT(f_out, f_inv)
    205217       DO  k = nzb_y, nzt_y
    206218          DO  i = nxl_y, nxr_y
     
    246258    !$OMP  PARALLEL PRIVATE ( i, j, k )
    247259    !$OMP  DO
     260     !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     261     !$ACC PRESENT(f_out, f_inv)
    248262     DO  k = 1, nz
    249263         DO  i = nxl, nxr
     
    293307
    294308    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work !<
     309    !$ACC DECLARE CREATE(work)
    295310
    296311
     
    307322       DO  l = 0, pdims(1) - 1
    308323          xs = 0 + l * nnx
     324          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     325          !$ACC PRESENT(work, f_in)
    309326          DO  k = nzb_x, nzt_x
    310327             DO  i = xs, xs + nnx - 1
     
    320337!--    Transpose array
    321338       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
     339       !$ACC UPDATE HOST(work)
    322340       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    323341       CALL MPI_ALLTOALL( work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, &
    324342                          f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL, &
    325343                          comm1dx, ierr )
     344       !$ACC UPDATE DEVICE(f_inv)
    326345       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
    327346#endif
     
    333352!$OMP  PARALLEL PRIVATE ( i, j, k )
    334353!$OMP  DO
     354       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     355       !$ACC PRESENT(f_inv, f_in)
    335356       DO  i = nxl, nxr
    336357          DO  j = nys, nyn
     
    378399    !$OMP  PARALLEL PRIVATE ( i, j, k )
    379400    !$OMP  DO
     401     !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     402     !$ACC PRESENT(f_out, f_inv)
    380403     DO  i = 0, nx
    381404         DO  k = nzb_x, nzt_x
     
    425448
    426449    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)
    427451
    428452
     
    436460       DO  l = 0, pdims(2) - 1
    437461          ys = 0 + l * ( nyn_x - nys_x + 1 )
     462          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     463          !$ACC PRESENT(work, f_in)
    438464          DO  i = nxl_y, nxr_y
    439465             DO  k = nzb_y, nzt_y
     
    449475!--    Transpose array
    450476       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
     477       !$ACC UPDATE HOST(work)
    451478       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    452479       CALL MPI_ALLTOALL( work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, &
    453480                          f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL, &
    454481                          comm1dy, ierr )
     482       !$ACC UPDATE DEVICE(f_inv)
    455483       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
    456484#endif
     
    462490!$OMP  PARALLEL PRIVATE ( i, j, k )
    463491!$OMP  DO
     492       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     493       !$ACC PRESENT(f_inv, f_in)
    464494       DO  i = nxl_y, nxr_y
    465495          DO  k = nzb_y, nzt_y
     
    587617    !$OMP  PARALLEL PRIVATE ( i, j, k )
    588618    !$OMP  DO
     619     !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     620     !$ACC PRESENT(f_inv, f_in)
    589621     DO  j = 0, ny
    590622         DO  k = nzb_y, nzt_y
     
    634666
    635667    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)
    636669
    637670
     
    643676!$OMP  PARALLEL PRIVATE ( i, j, k )
    644677!$OMP  DO
     678       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     679       !$ACC PRESENT(f_out, f_inv)
    645680       DO  j = 0, ny
    646681          DO  k = nzb_y, nzt_y
     
    658693!--    Transpose array
    659694       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
     695       !$ACC UPDATE HOST(f_inv)
    660696       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    661697       CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL, &
    662698                          work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, &
    663699                          comm1dx, ierr )
     700       !$ACC UPDATE DEVICE(work)
    664701       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
    665702
     
    670707       DO  l = 0, pdims(1) - 1
    671708          zs = 1 + l * ( nzt_y - nzb_y + 1 )
     709          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     710          !$ACC PRESENT(f_out, work)
    672711          DO  j = nys_z, nyn_z
    673712             DO  k = zs, zs + nzt_y - nzb_y
     
    714753    !$OMP  PARALLEL PRIVATE ( i, j, k )
    715754    !$OMP  DO
     755    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     756    !$ACC PRESENT(f_in, f_inv)
    716757     DO  k = 1,nz
    717758         DO  i = nxl, nxr
     
    761802
    762803    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work !<
     804    !$ACC DECLARE CREATE(work)
    763805
    764806
     
    770812!$OMP  PARALLEL PRIVATE ( i, j, k )
    771813!$OMP  DO
     814       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     815       !$ACC PRESENT(f_out, f_inv)
    772816       DO  k = 1, nz
    773817          DO  i = nxl, nxr
     
    785829!--    Transpose array
    786830       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
     831       !$ACC UPDATE HOST(f_inv)
    787832       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    788833       CALL MPI_ALLTOALL( f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL, &
    789834                          work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, &
    790835                          comm1dx, ierr )
     836       !$ACC UPDATE DEVICE(work)
    791837       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
    792838
     
    797843       DO  l = 0, pdims(1) - 1
    798844          xs = 0 + l * nnx
     845          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     846          !$ACC PRESENT(f_out, work)
    799847          DO  k = nzb_x, nzt_x
    800848             DO  i = xs, xs + nnx - 1
     
    845893    !$OMP  PARALLEL PRIVATE ( i, j, k )
    846894    !$OMP  DO
     895    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     896    !$ACC PRESENT(f_out, f_inv)
    847897     DO  k = nzb_y, nzt_y
    848898         DO  j = 0, ny
     
    892942
    893943    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)
    894945
    895946!
     
    905956       DO  l = 0, pdims(1) - 1
    906957          zs = 1 + l * ( nzt_y - nzb_y + 1 )
     958          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     959          !$ACC PRESENT(work, f_in)
    907960          DO  j = nys_z, nyn_z
    908961             DO  k = zs, zs + nzt_y - nzb_y
     
    918971!--    Transpose array
    919972       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start', cpu_log_nowait )
     973       !$ACC UPDATE HOST(work)
    920974       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    921975       CALL MPI_ALLTOALL( work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, &
    922976                          f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL, &
    923977                          comm1dx, ierr )
     978       !$ACC UPDATE DEVICE(f_inv)
    924979       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
    925980#endif
     
    930985!$OMP  PARALLEL PRIVATE ( i, j, k )
    931986!$OMP  DO
     987       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
     988       !$ACC PRESENT(f_inv, f_in)
    932989       DO  k = nzb_y, nzt_y
    933990          DO  j = 0, ny
  • palm/trunk/SOURCE/tridia_solver_mod.f90

    r3274 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3274 2018-09-24 15:42:55Z knoop
    2730! Modularization of all bulk cloud physics code components
    2831!
     
    150153
    151154       USE arrays_3d,                                                          &
    152            ONLY:  ddzu_pres, ddzw, rho_air_zw
     155           ONLY:  ddzu_pres, ddzw, rho_air_zw, tri
    153156
    154157       IMPLICIT NONE
     
    169172       CALL maketri
    170173       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))
    171178
    172179    END SUBROUTINE tridia_init
     
    290297
    291298          REAL(wp), DIMENSION(nxl_z:nxr_z,nys_z:nyn_z,0:nz-1)   ::  ar1 !<
     299          !$ACC DECLARE CREATE(ar1)
    292300
    293301!
    294302!--       Forward substitution
     303          !$ACC PARALLEL PRESENT(ar, ar1, tri) PRIVATE(i,j,k)
    295304          DO  k = 0, nz - 1
     305             !$ACC LOOP COLLAPSE(2)
    296306             DO  j = nys_z, nyn_z
    297307                DO  i = nxl_z, nxr_z
     
    306316             ENDDO
    307317          ENDDO
     318          !$ACC END PARALLEL
    308319
    309320!
     
    312323!--       by zero appearing if the pressure bc is set to neumann at the top of
    313324!--       the model domain.
     325          !$ACC PARALLEL PRESENT(ar, ar1, ddzuw, tri) PRIVATE(i,j,k)
    314326          DO  k = nz-1, 0, -1
     327             !$ACC LOOP COLLAPSE(2)
    315328             DO  j = nys_z, nyn_z
    316329                DO  i = nxl_z, nxr_z
     
    325338             ENDDO
    326339          ENDDO
     340          !$ACC END PARALLEL
    327341
    328342!
     
    332346          IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
    333347             IF ( nys_z == 0  .AND.  nxl_z == 0 )  THEN
     348                !$ACC PARALLEL LOOP PRESENT(ar)
    334349                DO  k = 1, nz
    335350                   ar(nxl_z,nys_z,k) = 0.0_wp
  • palm/trunk/SOURCE/turbulence_closure_mod.f90

    r3550 r3634  
    2525! -----------------
    2626! $Id$
     27! OpenACC port for SPEC
     28!
     29! 3550 2018-11-21 16:01:01Z gronemeier
    2730! - calculate diss production same in vector and cache optimization
    2831! - move boundary condition for e and diss to boundary_conds
     
    16191622       ENDDO  !k loop
    16201623
     1624       !$ACC ENTER DATA COPYIN(l_black(nzb:nzt+1))
     1625
    16211626    ENDIF  !LES or RANS mode
    16221627
     
    16241629!-- Set lateral boundary conditions for l_wall
    16251630    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))
    16261634
    16271635    CONTAINS
     
    17771785!--    Default surfaces, upward-facing
    17781786       !$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)
    17791789       DO  m = 1, surf_def_h(0)%ns
    17801790
     
    18111821!--    Default surfaces, downward-facing surfaces
    18121822       !$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)
    18131825       DO  m = 1, surf_def_h(1)%ns
    18141826
     
    18421854!--    Natural surfaces, upward-facing
    18431855       !$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)
    18441858       DO  m = 1, surf_lsm_h%ns
    18451859
     
    18761890!--    Urban surfaces, upward-facing
    18771891       !$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)
    18781894       DO  m = 1, surf_usm_h%ns
    18791895
     
    19701986             CALL advec_s_up( e )
    19711987          ELSE
     1988             !$ACC KERNELS PRESENT(tend)
    19721989             tend = 0.0_wp
     1990             !$ACC END KERNELS
    19731991             IF ( timestep_scheme(1:5) == 'runge' )  THEN
    19741992                IF ( ws_scheme_sca )  THEN
     
    20062024!--    reasons in the course of the integration. In such cases the old TKE
    20072025!--    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)
    20082030       DO  i = nxl, nxr
    20092031          DO  j = nys, nyn
     
    20242046       IF ( timestep_scheme(1:5) == 'runge' )  THEN
    20252047          IF ( intermediate_timestep_count == 1 )  THEN
     2048             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     2049             !$ACC PRESENT(tend, te_m)
    20262050             DO  i = nxl, nxr
    20272051                DO  j = nys, nyn
     
    20332057          ELSEIF ( intermediate_timestep_count < &
    20342058                   intermediate_timestep_count_max )  THEN
     2059             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
     2060             !$ACC PRESENT(tend, te_m)
    20352061             DO  i = nxl, nxr
    20362062                DO  j = nys, nyn
     
    23802406!-- points first, gradients at surface-bounded grid points will be
    23812407!-- 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))
    23822416    DO  i = nxl, nxr
    23832417       DO  j = nys, nyn
     2418          !$ACC LOOP PRIVATE(k)
    23842419          DO  k = nzb+1, nzt
    23852420
     
    24232458                surf_s = surf_def_v(l)%start_index(j,i)
    24242459                surf_e = surf_def_v(l)%end_index(j,i)
     2460                !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir)
    24252461                DO  m = surf_s, surf_e
    24262462                   k           = surf_def_v(l)%k(m)
     
    24412477                surf_s = surf_lsm_v(l)%start_index(j,i)
    24422478                surf_e = surf_lsm_v(l)%end_index(j,i)
     2479                !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir)
    24432480                DO  m = surf_s, surf_e
    24442481                   k           = surf_lsm_v(l)%k(m)
     
    24592496                surf_s = surf_usm_v(l)%start_index(j,i)
    24602497                surf_e = surf_usm_v(l)%end_index(j,i)
     2498                !$ACC LOOP PRIVATE(m, k, usvs, wsvs, km_neutral, sign_dir)
    24612499                DO  m = surf_s, surf_e
    24622500                   k           = surf_usm_v(l)%k(m)
     
    24792517                surf_s = surf_def_v(l)%start_index(j,i)
    24802518                surf_e = surf_def_v(l)%end_index(j,i)
     2519                !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir)
    24812520                DO  m = surf_s, surf_e
    24822521                   k     = surf_def_v(l)%k(m)
     
    24972536                surf_s = surf_lsm_v(l)%start_index(j,i)
    24982537                surf_e = surf_lsm_v(l)%end_index(j,i)
     2538                !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir)
    24992539                DO  m = surf_s, surf_e
    25002540                   k     = surf_lsm_v(l)%k(m)
     
    25152555                surf_s = surf_usm_v(l)%start_index(j,i)
    25162556                surf_e = surf_usm_v(l)%end_index(j,i)
     2557                !$ACC LOOP PRIVATE(m, k, vsus, wsus, km_neutral, sign_dir)
    25172558                DO  m = surf_s, surf_e
    25182559                   k     = surf_usm_v(l)%k(m)
     
    25342575             surf_s = surf_def_h(0)%start_index(j,i)
    25352576             surf_e = surf_def_h(0)%end_index(j,i)
     2577             !$ACC LOOP PRIVATE(m, k)
    25362578             DO  m = surf_s, surf_e
    25372579                k = surf_def_h(0)%k(m)
     
    25502592             surf_s = surf_lsm_h%start_index(j,i)
    25512593             surf_e = surf_lsm_h%end_index(j,i)
     2594             !$ACC LOOP PRIVATE(m, k)
    25522595             DO  m = surf_s, surf_e
    25532596                k = surf_lsm_h%k(m)
     
    25612604             surf_s = surf_usm_h%start_index(j,i)
    25622605             surf_e = surf_usm_h%end_index(j,i)
     2606             !$ACC LOOP PRIVATE(m, k)
    25632607             DO  m = surf_s, surf_e
    25642608                k = surf_usm_h%k(m)
     
    25732617             surf_s = surf_def_h(1)%start_index(j,i)
    25742618             surf_e = surf_def_h(1)%end_index(j,i)
     2619             !$ACC LOOP PRIVATE(m, k)
    25752620             DO  m = surf_s, surf_e
    25762621                k = surf_def_h(1)%k(m)
     
    25852630
    25862631
     2632          !$ACC LOOP PRIVATE(k, def, flag)
    25872633          DO  k = nzb+1, nzt
    25882634
     
    26842730          ELSE ! or IF ( .NOT. ocean_mode )  THEN
    26852731
     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)
    26862740             DO  i = nxl, nxr
    26872741                DO  j = nys, nyn
    26882742
     2743                   !$ACC LOOP PRIVATE(k)
    26892744                   DO  k = nzb+1, nzt
    26902745                      tmp_flux(k) = -1.0_wp * kh(k,j,i) * ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
     
    26972752                         surf_s = surf_def_h(l)%start_index(j,i)
    26982753                         surf_e = surf_def_h(l)%end_index(j,i)
     2754                         !$ACC LOOP PRIVATE(m, k)
    26992755                         DO  m = surf_s, surf_e
    27002756                            k = surf_def_h(l)%k(m)
     
    27062762                      surf_s = surf_lsm_h%start_index(j,i)
    27072763                      surf_e = surf_lsm_h%end_index(j,i)
     2764                      !$ACC LOOP PRIVATE(m, k)
    27082765                      DO  m = surf_s, surf_e
    27092766                         k = surf_lsm_h%k(m)
     
    27142771                      surf_s = surf_usm_h%start_index(j,i)
    27152772                      surf_e = surf_usm_h%end_index(j,i)
     2773                      !$ACC LOOP PRIVATE(m, k)
    27162774                      DO  m = surf_s, surf_e
    27172775                         k = surf_usm_h%k(m)
     
    27232781                      surf_s = surf_def_h(2)%start_index(j,i)
    27242782                      surf_e = surf_def_h(2)%end_index(j,i)
     2783                      !$ACC LOOP PRIVATE(m, k)
    27252784                      DO  m = surf_s, surf_e
    27262785                         k = surf_def_h(2)%k(m)
     
    27322791
    27332792!--                   Compute tendency for TKE-production from shear
     2793                     !$ACC LOOP PRIVATE(k, flag)
    27342794                      DO  k = nzb+1, nzt
    27352795                         flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_0(k,j,i),0) )
     
    36283688
    36293689    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
    36313695
    36323696    USE grid_variables,                                                        &
     
    36533717    REAL(wp)     ::  ll             !< adjusted l
    36543718    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
    36553732
    36563733#if defined( __nopointer )
     
    36593736    REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !< temperature
    36603737#endif
    3661     REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dissipation  !< TKE dissipation
     3738    REAL(wp)    ::  dissipation  !< TKE dissipation
    36623739
    36633740
    36643741!
    36653742!-- 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)
    36663750    DO  i = nxl, nxr
    36673751       DO  j = nys, nyn
     
    36753759             IF ( les_dynamic .OR. les_mw )  THEN
    36763760
     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
    36773788                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
    36813793
    36823794             ELSEIF ( rans_tke_l )  THEN
    36833795
     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
    36843827                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
    36893833
    36903834             ELSEIF ( rans_tke_e )  THEN
    36913835
    3692                 dissipation(k,j) = diss(k,j,i)
     3836                dissipation = diss(k,j,i)
    36933837
    36943838             ENDIF
     
    37103854                                           ) * ddzw(k) * drho_air(k)           &
    37113855                                         ) * 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
    37133864
    37143865          ENDDO
    37153866       ENDDO
    3716 
    3717 !
    3718 !--    Store dissipation if needed for calculating the sgs particle
    3719 !--    velocities
    3720        IF ( .NOT. rans_tke_e .AND. ( use_sgs_for_particles  .OR.               &
    3721             wang_kernel  .OR.  collision_turbulence  ) )  THEN
    3722           DO  j = nys, nyn
    3723              DO  k = nzb+1, nzt
    3724                 diss(k,j,i) = dissipation(k,j) * MERGE( 1.0_wp, 0.0_wp,        &
    3725                                                BTEST( wall_flags_0(k,j,i), 0 ) )
    3726              ENDDO
    3727           ENDDO
    3728        ENDIF
    3729 
    37303867    ENDDO
    37313868
     
    42574394!-- Downward facing surfaces
    42584395    !$OMP PARALLEL DO PRIVATE(i,j,k)
     4396    !$ACC PARALLEL LOOP PRIVATE(i,j,k) &
     4397    !$ACC PRESENT(bc_h(1), kh, km)
    42594398    DO  m = 1, bc_h(1)%ns
    42604399       i = bc_h(1)%i(m)
     
    42674406!-- Downward facing surfaces
    42684407    !$OMP PARALLEL DO PRIVATE(i,j,k)
     4408    !$ACC PARALLEL LOOP PRIVATE(i,j,k) &
     4409    !$ACC PRESENT(bc_h(0), kh, km)
    42694410    DO  m = 1, bc_h(0)%ns
    42704411       i = bc_h(0)%i(m)
     
    42774418!-- Model top
    42784419    !$OMP PARALLEL DO
     4420    !$ACC PARALLEL LOOP COLLAPSE(2) &
     4421    !$ACC PRESENT(kh, km)
    42794422    DO  i = nxlg, nxrg
    42804423       DO  j = nysg, nyng
     
    43154458 SUBROUTINE tcm_diffusivities_default( var, var_reference )
    43164459 
     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
    43174467    USE statistics,                                                            &
    43184468        ONLY :  rmask, sums_l_l
     
    43314481    REAL(wp)     ::  ll                  !< adjusted mixing length
    43324482    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
    43334489
    43344490#if defined( __nopointer )
     
    43444500!
    43454501!-- Initialization for calculation of the mixing length profile
     4502    !$ACC KERNELS PRESENT(sums_l_l)
    43464503    sums_l_l = 0.0_wp
     4504    !$ACC END KERNELS
    43474505
    43484506!
     
    43534511    IF ( les_dynamic .OR. les_mw )  THEN
    43544512       !$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)
    43554517       DO  i = nxlg, nxrg
    43564518          DO  j = nysg, nyng
     
    43614523!
    43624524!--             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
    43634552                CALL mixing_length_les( i, j, k, l, ll, var, var_reference )
     4553#endif
     4554
    43644555!
    43654556!--             Compute diffusion coefficients for momentum and heat
     
    44294620    ENDIF
    44304621
     4622    !$ACC KERNELS PRESENT(sums_l_l)
    44314623    sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn)   ! quasi boundary-condition for
    44324624                                                ! data output
     4625    !$ACC END KERNELS
    44334626!$OMP END PARALLEL
    44344627
Note: See TracChangeset for help on using the changeset viewer.