Changeset 1015 for palm/trunk/SOURCE/diffusion_s.f90

Timestamp:

Sep 27, 2012 9:23:24 AM (12 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:

• palm/trunk/SOURCE/diffusion_s.f90 (modified) (5 diffs)

palm/trunk/SOURCE/diffusion_s.f90

@@ -4 +4 @@
 ! Current revisions:
 ! ------------------
-!
+! accelerator version (*_acc) added
 !
 ! Former revisions:
@@ -48 +48 @@
 
     PRIVATE
-    PUBLIC diffusion_s
+    PUBLIC diffusion_s, diffusion_s_acc
 
     INTERFACE diffusion_s
@@ -54 +54 @@
        MODULE PROCEDURE diffusion_s_ij
     END INTERFACE diffusion_s
+
+    INTERFACE diffusion_s_acc
+       MODULE PROCEDURE diffusion_s_acc
+    END INTERFACE diffusion_s_acc
 
  CONTAINS
@@ -173 +177 @@
 
 !------------------------------------------------------------------------------!
-! Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
+! Call for all grid points - accelerator version
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_s_acc( s, s_flux_b, s_flux_t, wall_s_flux )
 
        USE arrays_3d
@@ -194 +198 @@
 #endif
 
+       !$acc kernels present( ddzu, ddzw, fwxm, fwxp, fwym, fwyp, kh )        &
+       !$acc         present( nzb_diff_s_inner, nzb_s_inner, nzb_s_outer, s ) &
+       !$acc         present( s_flux_b, s_flux_t, tend, wall_s_flux )         &
+       !$acc         present( wall_w_x, wall_w_y )
+       !$acc loop
+       DO  i = nxl, nxr
+          DO  j = nys,nyn
+!
+!--          Compute horizontal diffusion
+             !$acc loop vector( 32 )
+             DO  k = 1, nzt
+                IF ( k > nzb_s_outer(j,i) )  THEN
+
+                   tend(k,j,i) = tend(k,j,i)                                  &
+                                          + 0.5 * (                           &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
+                      - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
+                                                  ) * ddx2                    &
+                                          + 0.5 * (                           &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
+                      - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
+                                                  ) * ddy2
+                ENDIF
+             ENDDO
+
+!
+!--          Apply prescribed horizontal wall heatflux where necessary
+             !$acc loop vector(32)
+             DO  k = 1, nzt
+                IF ( k > nzb_s_inner(j,i)  .AND.  k <= nzb_s_outer(j,i)  .AND. &
+                     ( wall_w_x(j,i) /= 0.0  .OR.  wall_w_y(j,i) /= 0.0 ) )    &
+                THEN
+                   tend(k,j,i) = tend(k,j,i)                                  &
+                                                + ( fwxp(j,i) * 0.5 *         &
+                        ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
+                        + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1)                &
+                                                   -fwxm(j,i) * 0.5 *         &
+                        ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
+                        + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2)                &
+                                                  ) * ddx2                    &
+                                                + ( fwyp(j,i) * 0.5 *         &
+                        ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
+                        + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3)                &
+                                                   -fwym(j,i) * 0.5 *         &
+                        ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
+                        + ( 1.0 - fwym(j,i) ) * wall_s_flux(4)                &
+                                                  ) * ddy2
+                ENDIF
+             ENDDO
+
+!
+!--          Compute vertical diffusion. In case that surface fluxes have been
+!--          prescribed or computed at bottom and/or top, index k starts/ends at
+!--          nzb+2 or nzt-1, respectively.
+             !$acc loop vector( 32 )
+             DO  k = 1, nzt_diff
+                IF ( k >= nzb_diff_s_inner(j,i) )  THEN
+                   tend(k,j,i) = tend(k,j,i)                                  &
+                                       + 0.5 * (                              &
+            ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
+          - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k)   &
+                                               ) * ddzw(k)
+                ENDIF
+             ENDDO
+
+!
+!--          Vertical diffusion at the first computational gridpoint along
+!--          z-direction
+             !$acc loop vector( 32 )
+             DO  k = 1, nzt
+                IF ( use_surface_fluxes  .AND.  k == nzb_s_inner(j,i)+1 )  THEN
+                   tend(k,j,i) = tend(k,j,i)                                  &
+                                          + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
+                                                  * ( s(k+1,j,i)-s(k,j,i) )   &
+                                                  * ddzu(k+1)                 &
+                                              + s_flux_b(j,i)                 &
+                                            ) * ddzw(k)
+                ENDIF
+
+!
+!--             Vertical diffusion at the last computational gridpoint along
+!--             z-direction
+                IF ( use_top_fluxes  .AND.  k == nzt )  THEN
+                   tend(k,j,i) = tend(k,j,i)                                   &
+                                          + ( - s_flux_t(j,i)                  &
+                                              - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) )&
+                                                    * ( s(k,j,i)-s(k-1,j,i) )  &
+                                                    * ddzu(k)                  &
+                                            ) * ddzw(k)
+                ENDIF
+             ENDDO
+
+          ENDDO
+       ENDDO
+       !$acc end kernels
+
+    END SUBROUTINE diffusion_s_acc
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+    SUBROUTINE diffusion_s_ij( i, j, s, s_flux_b, s_flux_t, wall_s_flux )
+
+       USE arrays_3d
+       USE control_parameters
+       USE grid_variables
+       USE indices
+
+       IMPLICIT NONE
+
+       INTEGER ::  i, j, k
+       REAL    ::  vertical_gridspace
+       REAL    ::  wall_s_flux(0:4)
+       REAL, DIMENSION(nysg:nyng,nxlg:nxrg) ::  s_flux_b, s_flux_t
+#if defined( __nopointer )
+       REAL, DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  s
+#else
+       REAL, DIMENSION(:,:,:), POINTER ::  s
+#endif
+
 !
 !--    Compute horizontal diffusion