Changeset 711 for codes/icosagcm/trunk/src/sphere

Timestamp:

07/25/18 13:57:35 (6 years ago)

Author:

ymipsl

Message:

Adding halo transfer for scalar field ad vorticity point.
=> Use request "req_z1_scal" with transfer function

YM

File:

• codes/icosagcm/trunk/src/sphere/metric.f90 (modified) (6 diffs)

codes/icosagcm/trunk/src/sphere/metric.f90

@@ -7 +7 @@
     INTEGER :: neighbour(0:5)
     INTEGER :: edge(0:5)
+    INTEGER :: vertex(0:5)
     INTEGER :: assign_face
     INTEGER :: assign_i
@@ -32 +33 @@
   END TYPE t_edge_glo
     
+  TYPE t_vertices_glo
+   INTEGER :: assign_domain
+   INTEGER :: assign_i
+   INTEGER :: assign_j
+   INTEGER :: assign_pos
+   INTEGER :: assign_delta
+  END TYPE t_vertices_glo    
  
   TYPE(t_vertex_glo),ALLOCATABLE,SAVE :: vertex_glo(:,:,:)
   TYPE(t_cell_glo),ALLOCATABLE,SAVE :: cell_glo(:)
   TYPE(t_edge_glo),ALLOCATABLE,SAVE :: edge_glo(:)
+  TYPE(t_vertices_glo),ALLOCATABLE,SAVE :: vertices_glo(:)
   INTEGER :: ncell_glo
   
@@ -93 +102 @@
     ALLOCATE(tab_index(nb_face,nb_face,0:5))
     ALLOCATE(edge_glo(ncell_glo*3))
+    ALLOCATE(vertices_glo(ncell_glo*2))
     
     DO ind=1,ncell_glo
@@ -824 +834 @@
   END SUBROUTINE  set_cell_edge    
         
+  SUBROUTINE set_cell_vertex
+  IMPLICIT NONE
+    INTEGER :: i,j,k,k2
+    INTEGER :: ind,ind1,ind2
+    INTEGER :: ng1,ng2
+    INTEGER :: ne     
+  
+    DO ind=1,ncell_glo
+      cell_glo(ind)%vertex(:)=0
+    ENDDO
+    
+    ne=0
+    DO ind=1,ncell_glo
+      DO k=0,5
+        IF (cell_glo(ind)%vertex(k)==0) THEN
+          ind1=cell_glo(ind)%neighbour(k)
+          DO ng1=0,5
+            ind2=cell_glo(ind1)%neighbour(ng1)
+            DO ng2=0,5
+              IF (cell_glo(ind2)%neighbour(ng2)==ind) THEN
+                DO k2=0,5
+                  IF (cell_glo(ind)%neighbour(k2)==ind2) THEN
+                    IF (k2==k+1 .OR. k2==k+2 .OR. k2+6==k+1 .AND. k2+6==k+2) THEN
+                      IF (cell_glo(ind1)%vertex(ng1)==0 .AND. cell_glo(ind2)%vertex(ng2)==0) THEN
+                        ne=ne+1
+                        cell_glo(ind)%vertex(k)=ne 
+                        cell_glo(ind1)%vertex(ng1)=ne
+                        cell_glo(ind2)%vertex(ng2)=ne
+                      ELSE IF (cell_glo(ind1)%vertex(ng1)==0) THEN
+                        cell_glo(ind)%vertex(k)=cell_glo(ind2)%vertex(ng2)
+                        cell_glo(ind1)%vertex(ng1)=cell_glo(ind2)%vertex(ng2)
+                      ELSE IF (cell_glo(ind2)%vertex(ng2)==0) THEN
+                        cell_glo(ind)%vertex(k)=cell_glo(ind1)%vertex(ng1)
+                        cell_glo(ind2)%vertex(ng2)=cell_glo(ind1)%vertex(ng1)
+                      ENDIF
+                    ENDIF
+                  ENDIF
+                ENDDO
+              ENDIF
+            ENDDO
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDDO                      
+                     
+ 
+  END SUBROUTINE set_cell_vertex
+
+        
   SUBROUTINE set_vertex_edge
   IMPLICIT NONE
@@ -850 +909 @@
       ENDDO
     ENDDO
+
+
   END SUBROUTINE set_vertex_edge 
      
@@ -864 +925 @@
     CALL compute_extended_face_bis
     CALL set_cell_edge
+    CALL set_cell_vertex
     CALL set_vertex_edge