Changeset 683 for codes

Timestamp:

03/07/18 11:18:39 (6 years ago)

Author:

dubos

Message:

devel/unstructured : cleanup

Location:

codes/icosagcm/devel/src

Files:

• kernels_unst/coriolis.k90 (modified) (3 diffs)
• unstructured/data_unstructured.F90 (modified) (1 diff)
• unstructured/timestep_unstructured.F90 (modified) (5 diffs)

codes/icosagcm/devel/src/kernels_unst/coriolis.k90

@@ -180 +180 @@
       ! this VLOOP iterates over the TRISK stencil
       SELECT CASE(trisk_deg(edge))
-      CASE(10)
+      CASE(4)
          !DIR$ SIMD
          DO l = 1, llm
@@ -196 +196 @@
             edge_trisk = trisk(4,edge)
             du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
-            itrisk = 5
-            edge_trisk = trisk(5,edge)
-            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
-            itrisk = 6
-            edge_trisk = trisk(6,edge)
-            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
-            itrisk = 7
-            edge_trisk = trisk(7,edge)
-            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
-            itrisk = 8
-            edge_trisk = trisk(8,edge)
-            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
-            itrisk = 9
-            edge_trisk = trisk(9,edge)
-            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
-            itrisk = 10
-            edge_trisk = trisk(10,edge)
-            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
             du(l,edge) = du(l,edge) + .5*du_trisk
          END DO
-      CASE(4)
+      CASE(10)
          !DIR$ SIMD
          DO l = 1, llm
@@ -231 +213 @@
             itrisk = 4
             edge_trisk = trisk(4,edge)
+            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
+            itrisk = 5
+            edge_trisk = trisk(5,edge)
+            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
+            itrisk = 6
+            edge_trisk = trisk(6,edge)
+            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
+            itrisk = 7
+            edge_trisk = trisk(7,edge)
+            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
+            itrisk = 8
+            edge_trisk = trisk(8,edge)
+            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
+            itrisk = 9
+            edge_trisk = trisk(9,edge)
+            du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
+            itrisk = 10
+            edge_trisk = trisk(10,edge)
             du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk))
             du(l,edge) = du(l,edge) + .5*du_trisk

codes/icosagcm/devel/src/unstructured/data_unstructured.F90

@@ -61 +61 @@
           num(:), & ! number of cells to send to / receive from other MPI ranks
           cells(:) ! local indices of cells to send/receive
-     DBL, ALLOCATABLE :: buf1(:), buf2(:,:), buf3(:,:,:)
+     DBL, ALLOCATABLE :: buf2(:,:)
   END TYPE Halo_transfer
   TYPE(Halo_transfer), TARGET :: send_info(transfer_max), recv_info(transfer_max)

codes/icosagcm/devel/src/unstructured/timestep_unstructured.F90

@@ -135 +135 @@
     FIELD_UL     :: bufu1, bufu2, bufu3,bufu4
     DBL       :: time1,time2
-    INTEGER :: step, stage, ij
+    INTEGER :: step, stage, iq, ij
     
     !CALL CPU_TIME(time1)
@@ -153 +153 @@
           
           CALL update_halo(transfer_primal, rhodz)
-          CALL update_halo(transfer_primal, theta_rhodz(:,:,1)) ! FIXME
+          DO iq=1, nqdyn
+             CALL update_halo(transfer_primal, theta_rhodz(:,:,iq))
+          END DO
 
           IF(hydrostatic) THEN
@@ -172 +174 @@
 
              CALL compute_caldyn_slow_hydro(rhodz,theta,u, berni,hflux,du_slow(:,:,stage))
-             CALL compute_coriolis(hflux,theta,qu, bufu1, drhodz(:,:,stage), dtheta_rhodz(:,:,:,stage),du_slow(:,:,stage))
+             CALL compute_coriolis(hflux,theta,qu, bufu1, drhodz(:,:,stage), &
+                  dtheta_rhodz(:,:,:,stage),du_slow(:,:,stage))
              IF(caldyn_eta == eta_mass) THEN
                 CALL caldyn_vert(drhodz(:,:,stage),rhodz,theta,u, &
@@ -179 +182 @@
              
           ELSE ! NH
+             CALL update_halo(transfer_primal, geopot)
+             CALL update_halo(transfer_primal, W)
+             
              CALL compute_theta(mass_col,rhodz,theta_rhodz, theta)
              CALL compute_caldyn_solver(tauj(stage),rhodz,theta, bufm1,bufm2,bufm3, pk,geopot,W, &
                   dPhi_fast(:,:,stage), dW_fast(:,:,stage), du_fast(:,:,stage))
+
              CALL compute_caldyn_fast(tauj(stage), pk,berni,theta,geopot, du_fast(:,:,stage),u)
+             CALL update_halo(transfer_edge, u)
              CALL compute_pvort_only(rhodz,u,qv,qu)
-             CALL compute_caldyn_slow_NH(u,rhodz,geopot,W, bufm1,bufm2,bufm3,bufu1,bufu2,bufu3,bufu4, hflux, &
+             CALL update_halo(transfer_edge, qu)
+
+             CALL compute_caldyn_slow_NH(u,rhodz,geopot,W, bufm1,bufm2,bufm3, &
+                  bufu1,bufu2,bufu3,bufu4, hflux, &
                   du_slow(:,:,stage), dPhi_slow(:,:,stage), dW_slow(:,:,stage))
-             CALL compute_coriolis(hflux,theta,qu, bufu1, drhodz(:,:,stage),dtheta_rhodz(:,:,:,stage), du_slow(:,:,stage))
+             CALL compute_coriolis(hflux,theta,qu, bufu1, &
+                  drhodz(:,:,stage),dtheta_rhodz(:,:,:,stage), du_slow(:,:,stage))
              IF(caldyn_eta == eta_mass) THEN
                 CALL caldyn_vert(drhodz(:,:,stage),rhodz,theta,u, &
@@ -298 +310 @@
     CALL xios_get_handle("icosagcm",ctx_hdl)
     CALL xios_set_current_context(ctx_hdl)
-    !   CALL xios_set_axis_attr("lev",n_glo=llm ,value=lev_value) ;
-    !   CALL xios_set_axis_attr("levp1",n_glo=llm+1 ,value=lev_valuep1) ;
-    !   CALL xios_set_axis_attr("nq",n_glo=nqtot, value=nq_value) ;
-    !   CALL xios_set_domaingroup_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
-    !   CALL xios_set_domaingroup_attr("i", data_dim=1, type='unstructured' , nvertex=6, i_index=ind_glo)
-    !   CALL xios_set_domaingroup_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
-    !   CALL xios_set_domain_attr("u",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
-    !   CALL xios_set_domain_attr("u", data_dim=1, type='unstructured' , nvertex=2, i_index=ind_glo)
-    !  CALL xios_set_domain_attr("u",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
-    !   CALL xios_set_domain_attr("v",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
-    !   CALL xios_set_domain_attr("v", data_dim=1, type='unstructured' , nvertex=3)
-    !   CALL xios_set_domain_attr("v",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
-    !   CALL xios_set_timestep(dtime)  
-    !   CALL xios_set_fieldgroup_attr("standard_output", freq_op=itau_out*xios_timestep, freq_offset=(itau_out-1)*xios_timestep)    
-    ! CALL xios_close_context_definition()
-    
-    ! PRINT *, 'Read data'
-    ! CALL xios_recv_field(name,field)
-    
-    ! PRINT *,'Write data'
-    ! CALL xios_send_field(name,field_tmp)
-    
-   !   PRINT *, 'Flush to disk, clean up and die'
-   !   CALL xios_context_finalize
   END SUBROUTINE setup_xios
-!
+
   SUBROUTINE call_xios_set_timestep(dt) BINDC(xios_set_timestep)
     DBL, VALUE :: dt