Changeset 953 for codes/icosagcm/trunk/src/time/timeloop_gcm.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/time/timeloop_gcm.F90 (moved) (moved from codes/icosagcm/trunk/src/time/timeloop_gcm.f90) (16 diffs)

codes/icosagcm/trunk/src/time/timeloop_gcm.F90

@@ -94 +94 @@
     END SELECT
     
+    IF (scheme_family /= hevi) THEN
+       CALL abort_acc("scheme_family /= hevi")
+    END IF
+
     ! Time-independant orography
     CALL allocate_field(f_phis,field_t,type_real,name='phis')
@@ -103 +107 @@
     CALL allocate_field(f_u,field_u,type_real,llm,name='u')
     CALL allocate_field(f_geopot,field_t,type_real,llm+1,name='geopot')
-    CALL allocate_field(f_W,field_t,type_real,llm+1,name='W')
+    CALL allocate_field(f_W,field_t,type_real,llm+1,name='W') ! used only if .not. hydrostatic
     CALL allocate_field(f_q,field_t,type_real,llm,nqtot,'q')
     ! Mass fluxes
-    CALL allocate_field(f_hflux,field_u,type_real,llm)    ! instantaneous mass fluxes
-    CALL allocate_field(f_hfluxt,field_u,type_real,llm)   ! mass "fluxes" accumulated in time
+    CALL allocate_field(f_hflux,field_u,type_real,llm, ondevice=.TRUE.)    ! instantaneous mass fluxes
+    CALL allocate_field(f_hfluxt,field_u,type_real,llm,ondevice=.TRUE.)   ! mass "fluxes" accumulated in time
     CALL allocate_field(f_wflux,field_t,type_real,llm+1)  ! vertical mass fluxes
-    CALL allocate_field(f_wfluxt,field_t,type_real,llm+1,name='wfluxt')
+    CALL allocate_field(f_wfluxt,field_t,type_real,llm+1,name='wfluxt',ondevice=.TRUE.)
     
     SELECT CASE(scheme_family)
@@ -125 +129 @@
     CASE(hevi)
        ! Trends
-       CALL allocate_fields(nb_stage,f_dps_slow, field_t,type_real,name='dps_slow')
-       CALL allocate_fields(nb_stage,f_dmass_slow, field_t,type_real,llm, name='dmass_slow')
-       CALL allocate_fields(nb_stage,f_dtheta_rhodz_slow, field_t,type_real,llm,nqdyn,name='dtheta_rhodz_fast')
-       CALL allocate_fields(nb_stage,f_du_slow, field_u,type_real,llm,name='du_slow')
-       CALL allocate_fields(nb_stage,f_du_fast, field_u,type_real,llm,name='du_fast')
+       CALL allocate_fields(nb_stage,f_dps_slow, field_t,type_real,name='dps_slow', ondevice=.TRUE.)
+       CALL allocate_fields(nb_stage,f_dmass_slow, field_t,type_real,llm, name='dmass_slow', ondevice=.TRUE.)
+       CALL allocate_fields(nb_stage,f_dtheta_rhodz_slow, field_t,type_real,llm,nqdyn,name='dtheta_rhodz_fast', ondevice=.TRUE.)
+       CALL allocate_fields(nb_stage,f_du_slow, field_u,type_real,llm,name='du_slow', ondevice=.TRUE.)
+       CALL allocate_fields(nb_stage,f_du_fast, field_u,type_real,llm,name='du_fast', ondevice=.TRUE.)
        CALL allocate_fields(nb_stage,f_dW_slow, field_t,type_real,llm+1,name='dW_slow')
        CALL allocate_fields(nb_stage,f_dW_fast, field_t,type_real,llm+1,name='dW_fast')
@@ -172 +176 @@
   
   SUBROUTINE timeloop
+    USE abort_mod
     USE dissip_gcm_mod
     USE sponge_mod
@@ -211 +216 @@
        rhodz=f_rhodz(ind); mass=f_mass(ind); ps=f_ps(ind)
        IF(caldyn_eta==eta_mass) THEN
-          CALL compute_rhodz(.TRUE., ps, rhodz) ! save rhodz for transport scheme before dynamics update ps
+          CALL compute_rhodz(.TRUE., ps, rhodz, ondevice=.FALSE.) ! save rhodz for transport scheme before dynamics update ps
        ELSE
           DO l=ll_begin,ll_end
@@ -244 +249 @@
     CALL SYSTEM_CLOCK(start_clock, rate_clock)
     !$OMP END MASTER   
+    call update_device_field(f_ps)
+    call update_device_field(f_mass)
+    CALL update_device_field(f_theta_rhodz)
+    CALL update_device_field(f_u)
+    CALL update_device_field(f_q)
+    CALL update_device_field(f_geopot)
+    CALL update_device_field(f_wflux)
+    CALL update_device_field(f_rhodz)
+
 
     DO it=itau0+1,itau0+itaumax
@@ -263 +277 @@
           CALL wait_message(req_mass0)
           CALL send_message(f_theta_rhodz,req_theta_rhodz0) 
-          CALL wait_message(req_theta_rhodz0) 
+          CALL wait_message(req_theta_rhodz0)
           CALL send_message(f_u,req_u0)
           CALL wait_message(req_u0)
@@ -281 +295 @@
        SELECT CASE(scheme_family)
        CASE(explicit)
+          CALL abort_acc("explicit_scheme")
           CALL explicit_scheme(it, fluxt_zero)
        CASE(hevi)
@@ -298 +313 @@
                 CALL swap_geometry(ind)
                 mass=f_mass(ind); ps=f_ps(ind);
-                CALL compute_rhodz(.TRUE., ps, mass)
+                CALL compute_rhodz(.TRUE., ps, mass, ondevice=.TRUE.)
              END DO
           ENDIF
@@ -311 +326 @@
           CALL euler_scheme(.FALSE.)  ! update only u, theta
           IF (iflag_sponge > 0) THEN
+             CALL abort_acc("iflag_sponge>0")
              CALL sponge(f_u,f_du,f_theta_rhodz,f_dtheta_rhodz)
              CALL euler_scheme(.FALSE.)  ! update only u, theta
@@ -321 +337 @@
        END IF
        CALL exit_profile(id_dissip)
-       
+
        CALL enter_profile(id_adv)
        IF(MOD(it,itau_adv)==0) THEN
@@ -329 +345 @@
           ! At this point advect_tracer has obtained the halos of u and rhodz,
           ! needed for correct computation of kinetic energy
+          IF(diagflux_on) CALL abort_acc("diagflux_on")
           IF(diagflux_on) CALL diagflux_energy(adv_over_out, f_phis,f_rhodz,f_theta_rhodz,f_u, f_geopot,f_theta,f_buf_i, f_hfluxt)
 
@@ -340 +357 @@
              END DO
           ENDIF
+          IF(positive_theta) CALL abort_acc("positive_theta")
           IF(positive_theta) CALL copy_q_to_theta(f_theta_rhodz,f_rhodz,f_q)
        END IF
        CALL exit_profile(id_adv)
-       
+
        CALL enter_profile(id_diags)
 !       IF (MOD(it,itau_physics)==0) THEN
@@ -360 +378 @@
 
        IF (MOD(it,itau_check_conserv)==0) THEN
+          CALL update_host_field(f_ps)
+          CALL update_host_field(f_theta_rhodz)
+          CALL update_host_field(f_u)
+          CALL update_host_field(f_dps)
+          CALL update_host_field(f_q)
           CALL check_conserve_detailed(it, AAM_dyn, &
                f_ps,f_dps,f_u,f_theta_rhodz,f_phis)
@@ -367 +390 @@
        IF (mod(it,itau_out)==0 ) THEN
           CALL transfert_request(f_u,req_e1_vect)
+          CALL update_host_field(f_ps)              
+          CALL update_host_field(f_mass)
+          CALL update_host_field(f_theta_rhodz)
+          CALL update_host_field(f_geopot)
+          CALL update_host_field(f_u)
+          CALL update_host_field(f_q)
           CALL write_output_fields_basic(.FALSE.,f_phis, f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q)
        ENDIF
@@ -374 +403 @@
     END DO
     
+    CALL update_host_field(f_ps)
+    CALL update_host_field(f_theta_rhodz)
+    CALL update_host_field(f_u)
+    CALL update_host_field(f_q)
+    CALL update_host_field(f_geopot)
+
 !    CALL write_etat0(itau0+itaumax,f_ps, f_phis,f_theta_rhodz,f_u,f_q) 
     CALL write_etat0(itau0+itaumax,f_ps, f_phis,f_theta_rhodz,f_u,f_q, f_geopot, f_W) 
-    
+
+    CALL update_host_field(f_dps)    
     CALL check_conserve_detailed(it, AAM_dyn, &
          f_ps,f_dps,f_u,f_theta_rhodz,f_phis)