Changeset 953 for codes/icosagcm/trunk/src/transport/advect.F90

Timestamp:

07/15/19 12:29:31 (5 years ago)

Author:

adurocher

Message:

trunk : GPU implementation with OpenACC ( merge from glcp.idris.fr )

File:

• codes/icosagcm/trunk/src/transport/advect.F90 (modified) (14 diffs)

codes/icosagcm/trunk/src/transport/advect.F90

@@ -49 +49 @@
   !=======================================================================================
 
-  SUBROUTINE compute_gradq3d(qi,sqrt_leng,gradq3d,xyz_i,xyz_v)
+  SUBROUTINE compute_gradq3d(qi,sqrt_leng,gradq3d,xyz_i, xyz_v)
     USE trace
     USE omp_para
@@ -68 +68 @@
     REAL(rstd) :: x1,x2,x3
     REAL(rstd) :: dq(3)
-
+    
     CALL trace_start("compute_gradq3d1")
 
@@ -86 +86 @@
 !    END DO
 
-     DO l = ll_begin,ll_end 
+     !$acc data create(gradtri(:,:,:), arr(:), ar(:)) present(sqrt_leng(:), xyz_i(:,:), xyz_v(:,:), qi(:,:), gradq3d(:,:,:)) async
+
+     !$acc parallel loop collapse(2) async private(A, dq)
+     DO l = ll_begin,ll_end
 !DIR$ SIMD
       DO ij=ij_begin_ext,ij_end_ext
@@ -151 +154 @@
         
       ENDDO
+     ENDDO
       
+     !$acc parallel loop collapse(2) async private(A, dq)
+     DO l = ll_begin,ll_end
       DO ij=ij_begin_ext,ij_end_ext
 
@@ -219 +225 @@
 
 !DIR$ SIMD
+    !$acc parallel loop async
     DO ij=ij_begin,ij_end
        ar(ij) = arr(ij+z_up)+arr(ij+z_lup)+arr(ij+z_ldown)+arr(ij+z_down)+arr(ij+z_rdown)+arr(ij+z_rup)+1.e-50
@@ -225 +232 @@
     CALL trace_start2("compute_gradq3d2")
       
+    !$acc parallel loop collapse(3) async
     DO k=1,3
       DO l =ll_begin,ll_end
@@ -239 +247 @@
 
     !============================================================================================= LIMITING 
+    !$acc parallel loop collapse(2) async
     DO l =ll_begin,ll_end
 !DIR$ SIMD
@@ -251 +260 @@
              minq = min(qi(ij,l),qi(ij+t_right,l),qi(ij+t_lup,l),qi(ij+t_rup,l),qi(ij+t_left,l), &
                   qi(ij+t_rdown,l),qi(ij+t_ldown,l))
-             alphamx = (maxq - qi(ij,l)) ; alphamx = alphamx/(maxq_c - qi(ij,l) )
-             alphamx = max(alphamx,0.0)
-             alphami = (minq - qi(ij,l)); alphami = alphami/(minq_c - qi(ij,l))
-             alphami = max(alphami,0.0) 
+             IF ((maxq_c - qi(ij,l)) /= 0.0) THEN
+               alphamx = (maxq - qi(ij,l)) ; alphamx = alphamx/(maxq_c - qi(ij,l) )
+               alphamx = max(alphamx,0.0)
+             ELSE
+               alphamx = 0.0
+             ENDIF
+             IF ((minq_c - qi(ij,l)) /= 0.0) THEN
+               alphami = (minq - qi(ij,l)); alphami = alphami/(minq_c - qi(ij,l))
+               alphami = max(alphami,0.0)
+             ELSE
+               alphami = 0.0
+             ENDIF
              alpha   = min(alphamx,alphami,1.0)
 !             gradq3d(ij,l,:) = alpha*gradq3d(ij,l,:)
@@ -264 +281 @@
 
   CALL trace_end("compute_gradq3d3")
+
+  !$acc end data
   
   CONTAINS
@@ -329 +348 @@
 
   ! Backward trajectories, for use with Miura approach
-  SUBROUTINE compute_backward_traj(normal,tangent,ue,tau, cc)
+  SUBROUTINE compute_backward_traj(normal,tangent,ue,tau,cc)
+    USE geometry, ONLY : xyz_e, de, wee, le
     USE trace
     USE omp_para
@@ -345 +365 @@
 
     ! TODO : compute normal displacement ue*tau as hfluxt / mass(upwind) then reconstruct tangential displacement
-    
+
+    !$acc data present(ue(:,:), cc(:,:,:), normal(:,:), tangent(:,:), xyz_e(:,:), de(:), wee(:,:,:), le(:)) async
+
     ! reconstruct tangential wind then 3D wind at edge then cc = edge midpoint - u*tau
+    !$acc parallel loop private(up_e, v_e) collapse(2) gang vector async
     DO l = ll_begin,ll_end
 !DIR$ SIMD
@@ -397 +420 @@
        ENDDO
     END DO
-
+    !$acc end data
     CALL trace_end("compute_backward_traj")
 
@@ -404 +427 @@
   ! Horizontal transport (S. Dubey, T. Dubos)
   ! Slope-limited van Leer approach with hexagons
-  SUBROUTINE compute_advect_horiz(update_mass,diagflux_on, hfluxt,cc,gradq3d, mass,qi,qfluxt)
+  SUBROUTINE compute_advect_horiz(update_mass,diagflux_on, hfluxt,cc,gradq3d, mass, qi, qfluxt)
     USE trace
     USE omp_para
+    USE abort_mod
+    USE geometry, only : Ai, xyz_i
     IMPLICIT NONE
     LOGICAL, INTENT(IN)       :: update_mass, diagflux_on
@@ -415 +440 @@
     REAL(rstd), INTENT(INOUT) :: qi(iim*jjm,llm)
     REAL(rstd), INTENT(INOUT) :: qfluxt(3*iim*jjm,MERGE(llm,1,diagflux_on)) ! time-integrated tracer flux
-
-    REAL(rstd) :: dq,dmass,qe, newmass
+! metrics terms
+    
+    REAL(rstd) :: dq,dmass,qe,newmass
     REAL(rstd) :: qflux(3*iim*jjm,llm)
-    INTEGER :: ij,l
+    INTEGER :: ij,l,ij_tmp
+
+    IF(diagflux_on) CALL abort_acc("compute_advect_horiz : diagflux_on")
 
     CALL trace_start("compute_advect_horiz")
 #include "../kernels/advect_horiz.k90"
     CALL trace_end("compute_advect_horiz")
+
   END SUBROUTINE compute_advect_horiz