Ignore:
Timestamp:
Sep 27, 2012 9:23:24 AM (9 years ago)
Author:
raasch
Message:

Starting with changes required for GPU optimization. OpenACC statements for using NVIDIA GPUs added.
Adjustment of mixing length to the Prandtl mixing length at first grid point above ground removed.
mask array is set zero for ghost boundaries

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/diffusion_w.f90

    r1002 r1015  
    44! Current revisions:
    55! -----------------
    6 !
     6! accelerator version (*_acc) added
    77!
    88! Former revisions:
     
    5050
    5151    PRIVATE
    52     PUBLIC diffusion_w
     52    PUBLIC diffusion_w, diffusion_w_acc
    5353
    5454    INTERFACE diffusion_w
     
    5656       MODULE PROCEDURE diffusion_w_ij
    5757    END INTERFACE diffusion_w
     58
     59    INTERFACE diffusion_w_acc
     60       MODULE PROCEDURE diffusion_w_acc
     61    END INTERFACE diffusion_w_acc
    5862
    5963 CONTAINS
     
    170174
    171175!------------------------------------------------------------------------------!
     176! Call for all grid points - accelerator version
     177!------------------------------------------------------------------------------!
     178    SUBROUTINE diffusion_w_acc
     179
     180       USE arrays_3d
     181       USE control_parameters
     182       USE grid_variables
     183       USE indices
     184
     185       IMPLICIT NONE
     186
     187       INTEGER ::  i, j, k
     188       REAL    ::  kmxm, kmxp, kmym, kmyp
     189
     190       !$acc declare create ( wsus, wsvs )
     191       REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) ::  wsus, wsvs
     192
     193
     194!
     195!--    First calculate horizontal momentum flux w'u' and/or w'v' at vertical
     196!--    walls, if neccessary
     197       IF ( topography /= 'flat' )  THEN
     198          CALL wall_fluxes_acc( wsus, 0.0, 0.0, 0.0, 1.0, nzb_w_inner, &
     199                                nzb_w_outer, wall_w_x )
     200          CALL wall_fluxes_acc( wsvs, 0.0, 0.0, 1.0, 0.0, nzb_w_inner, &
     201                                nzb_w_outer, wall_w_y )
     202       ENDIF
     203
     204       !$acc kernels present ( u, v, w, km, tend, vsws, vswst )    &
     205       !$acc         present ( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, wall_w_x, wall_w_y )           &
     206       !$acc         present ( nzb_w_inner, nzb_w_outer )
     207       !$acc loop
     208       DO  i = nxl, nxr
     209          DO  j = nys, nyn
     210             !$acc loop vector( 32 )
     211             DO  k = 1, nzt
     212                IF ( k > nzb_w_outer(j,i) )  THEN
     213!
     214!--                Interpolate eddy diffusivities on staggered gridpoints
     215                   kmxp = 0.25 * &
     216                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
     217                   kmxm = 0.25 * &
     218                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
     219                   kmyp = 0.25 * &
     220                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
     221                   kmym = 0.25 * &
     222                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
     223
     224                   tend(k,j,i) = tend(k,j,i)                                     &
     225                         & + ( kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx        &
     226                         &   + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)  &
     227                         &   - kmxm * ( w(k,j,i)   - w(k,j,i-1) ) * ddx          &
     228                         &   - kmxm * ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)    &
     229                         &   ) * ddx                                             &
     230                         & + ( kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy        &
     231                         &   + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)  &
     232                         &   - kmym * ( w(k,j,i)   - w(k,j-1,i) ) * ddy          &
     233                         &   - kmym * ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)    &
     234                         &   ) * ddy                                             &
     235                         & + 2.0 * (                                             &
     236                         &   km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
     237                         & - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
     238                         &         ) * ddzu(k+1)
     239                ENDIF
     240             ENDDO
     241
     242!
     243!--          Wall functions at all vertical walls, where necessary
     244             !$acc loop vector( 32 )
     245             DO  k = 1,nzt
     246
     247                IF ( k > nzb_w_inner(j,i)  .AND.  k <= nzb_w_outer(j,i)  .AND. &
     248                     wall_w_x(j,i) /= 0.0  .AND.  wall_w_y(j,i) /= 0.0 )  THEN
     249!
     250!--                Interpolate eddy diffusivities on staggered gridpoints
     251                   kmxp = 0.25 * &
     252                          ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
     253                   kmxm = 0.25 * &
     254                          ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
     255                   kmyp = 0.25 * &
     256                          ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
     257                   kmym = 0.25 * &
     258                          ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
     259
     260                   tend(k,j,i) = tend(k,j,i)                                   &
     261                                 + (   fwxp(j,i) * (                           &
     262                            kmxp * ( w(k,j,i+1)   - w(k,j,i)   ) * ddx         &
     263                          + kmxp * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1)   &
     264                                                   )                           &
     265                                     - fwxm(j,i) * (                           &
     266                            kmxm * ( w(k,j,i)     - w(k,j,i-1) ) * ddx         &
     267                          + kmxm * ( u(k+1,j,i)   - u(k,j,i)   ) * ddzu(k+1)   &
     268                                                   )                           &
     269                                     + wall_w_x(j,i) * wsus(k,j,i)             &
     270                                   ) * ddx                                     &
     271                                 + (   fwyp(j,i) * (                           &
     272                            kmyp * ( w(k,j+1,i)   - w(k,j,i)   ) * ddy         &
     273                          + kmyp * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1)   &
     274                                                   )                           &
     275                                     - fwym(j,i) * (                           &
     276                            kmym * ( w(k,j,i)     - w(k,j-1,i) ) * ddy         &
     277                          + kmym * ( v(k+1,j,i)   - v(k,j,i)   ) * ddzu(k+1)   &
     278                                                   )                           &
     279                                     + wall_w_y(j,i) * wsvs(k,j,i)             &
     280                                   ) * ddy                                     &
     281                                 + 2.0 * (                                     &
     282                           km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
     283                         - km(k,j,i)   * ( w(k,j,i)   - w(k-1,j,i) ) * ddzw(k) &
     284                                         ) * ddzu(k+1)
     285                ENDIF
     286             ENDDO
     287
     288          ENDDO
     289       ENDDO
     290       !$acc end kernels
     291
     292    END SUBROUTINE diffusion_w_acc
     293
     294
     295!------------------------------------------------------------------------------!
    172296! Call for grid point i,j
    173297!------------------------------------------------------------------------------!
Note: See TracChangeset for help on using the changeset viewer.