Changeset 1046

Timestamp:

08/20/20 16:22:41 (4 years ago)

Author:

ymipsl

Message:

Introduce modification from A. Durocher github to make held&suarez testcase working on GPU

YM & AD

Location:

codes/icosagcm/trunk/src

Files:

• diagnostics/geopotential_mod.f90 (modified) (1 diff)
• diagnostics/theta_rhodz.f90 (modified) (6 diffs)
• initial/etat0_academic.f90 (modified) (1 diff)
• initial/etat0_heldsz.f90 (modified) (4 diffs)
• physics/physics.f90 (modified) (6 diffs)

codes/icosagcm/trunk/src/diagnostics/geopotential_mod.f90

@@ -28 +28 @@
        theta_rhodz = f_theta_rhodz(ind)
        theta = f_theta(ind)
-       CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0)
+       CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0, ondevice=.FALSE.)
        phis = f_phis(ind)
        phi = f_phi(ind)

codes/icosagcm/trunk/src/diagnostics/theta_rhodz.f90

@@ -39 +39 @@
       theta_rhodz=f_theta_rhodz(ind)
       theta=f_theta(ind)
-      CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0)
+      CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0, ondevice=.false.)
     ENDDO
 !$OMP BARRIER
@@ -132 +132 @@
       theta=f_theta(ind)
       theta_rhodz=f_theta_rhodz(ind)
-      CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0)
+      CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0,ondevice=.false.)
     ENDDO
 !$OMP BARRIER
@@ -138 +138 @@
   END SUBROUTINE theta2theta_rhodz
   
-  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset)
+  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset, ondevice)
   USE icosa
   USE disvert_mod
@@ -147 +147 @@
     REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
     INTEGER,INTENT(IN) :: offset
+    LOGICAL, INTENT(IN) :: ondevice
     REAL(rstd) :: rhodz
     INTEGER :: i,j,ij,l
     
 !$OMP BARRIER
+    !$acc parallel loop collapse(3) default(present) async if(ondevice)
     DO    l    = ll_begin, ll_end
       DO j=jj_begin-offset,jj_end+offset
@@ -165 +167 @@
   END SUBROUTINE compute_theta2theta_rhodz
 
-  SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset)
+  SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset,ondevice)
   USE icosa
   USE disvert_mod
@@ -174 +176 @@
     REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm)
     INTEGER,INTENT(IN) :: offset
+    LOGICAL, INTENT(IN) :: ondevice
     REAL(rstd) :: rhodz
     INTEGER :: i,j,ij,l
 
 !$OMP BARRIER
+    !$acc parallel loop collapse(3) default(present) async if(ondevice)
     DO    l    = ll_begin, ll_end
       DO j=jj_begin-offset,jj_end+offset

codes/icosagcm/trunk/src/initial/etat0_academic.f90

@@ -228 +228 @@
     ENDDO
 
-    CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1)
+    CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1, ondevice=.false.)
        
 

codes/icosagcm/trunk/src/initial/etat0_heldsz.f90

@@ -89 +89 @@
        theta=f_theta(ind)
        CALL compute_etat0_heldsz(theta_eq,theta)
-       CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz(:,:,1),1)
+       CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz(:,:,1),1, ondevice=.false.)
        IF(nqtot>0) THEN
           q=f_q(ind)
@@ -96 +96 @@
           IF(nqtot>2) q(:,:,3:)=0.
        END IF
+   
+       call update_device_field(f_theta_eq)
+       call update_device_field(f_theta)
+      !$acc enter data copyin(knewt_t(:)) async
+      !$acc enter data copyin(kfrict(:)) async
+
     ENDDO
   END SUBROUTINE etat0
@@ -236 +242 @@
     INTEGER :: i,j,l,ij
 
-    CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,1)
+    CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,1, ondevice=.TRUE.)
     DO l=ll_begin,ll_end
        DO j=jj_begin-1,jj_end+1
@@ -246 +252 @@
        ENDDO
     ENDDO
-    CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1)
-
-    Do l=ll_begin,ll_end
+    CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1, ondevice=.true.)
+
+    !$acc kernels default(present) async
+    DO l=ll_begin,ll_end
        u(:,l)=u(:,l)*(1.-itau_physics*dt*kfrict(l))
     END DO
+    !$acc end kernels
 
   END SUBROUTINE compute_heldsz

codes/icosagcm/trunk/src/physics/physics.f90

@@ -113 +113 @@
 
 !$OMP PARALLEL
-    CALL allocate_field(f_du_phys,field_u,type_real,llm, name='du_phys')
+    CALL allocate_field(f_du_phys,field_u,type_real,llm, name='du_phys', ondevice=.TRUE.)
 
     IF(is_mpi_root) PRINT *, 'phys_type = ',phys_type
@@ -119 +119 @@
     
 !$OMP END PARALLEL
-    IF (phys_type /= phys_none) THEN
-       CALL abort_acc("physics /= 'none'")
+    IF (phys_type /= phys_none .AND. phys_type /= phys_HS94) THEN
+       CALL abort_acc("only phys_type == 'phys_none' or 'phys_HS94' supported")
     END IF
   END SUBROUTINE init_physics
@@ -133 +133 @@
        CALL swap_geometry(ind)
        du=f_du_phys(ind)
+
+       !$acc kernels default(present) async
        du(:,ll_begin:ll_end) = 0.
+       !$acc end kernels
+          
     END DO
   END SUBROUTINE zero_du_phys
@@ -141 +145 @@
     TYPE(t_field),POINTER :: f_u(:) ! velocity field before/after call to physics
     REAL(rstd), DIMENSION(:,:), POINTER :: u, du
-    INTEGER :: ind
+    INTEGER :: ind, ij
+
     DO ind=1,ndomain
        IF (.NOT. assigned_domain(ind)) CYCLE
@@ -148 +153 @@
        du=f_du_phys(ind)
        u=f_u(ind)
-       du(:,ll_begin:ll_end) = du(:,ll_begin:ll_end) + coef*u(:,ll_begin:ll_end)
+
+       !$acc parallel loop default(present) async
+       DO ij = ij_begin, ij_end
+          du(ij,ll_begin:ll_end) = du(ij,ll_begin:ll_end) + coef*u(ij,ll_begin:ll_end)
+       END DO
+
     END DO
   END SUBROUTINE add_du_phys
@@ -228 +238 @@
     USE wind_mod
     USE output_field_mod
-    CALL transfert_request(f_du_phys,req_e1_vect)
+
+    CALL transfert_request(f_du_phys,req_e1_vect)    
+    CALL update_host_field(f_du_phys)
+
     CALL un2ulonlat(f_du_phys, f_buf_ulon, f_buf_ulat, (1./(dt*itau_out)))
     CALL output_field("dulon_phys",f_buf_ulon)