Changeset 726 for codes/icosagcm/devel/src/parallel/domain.f90

Timestamp:

08/22/18 17:28:01 (6 years ago)

Author:

dubos

Message:

devel : backported from trunk commits r707-r711,r713

File:

• codes/icosagcm/devel/src/parallel/domain.f90 (modified) (7 diffs)

codes/icosagcm/devel/src/parallel/domain.f90

@@ -25 +25 @@
     INTEGER,POINTER  :: edge_assign_pos(:,:,:)
     INTEGER,POINTER  :: edge_assign_sign(:,:,:)
+    INTEGER,POINTER  :: vertex_assign_domain(:,:,:)
+    INTEGER,POINTER  :: vertex_assign_i(:,:,:)
+    INTEGER,POINTER  :: vertex_assign_j(:,:,:)
+    INTEGER,POINTER  :: vertex_assign_pos(:,:,:)
     REAL,POINTER     :: xyz(:,:,:)
     REAL,POINTER     :: neighbour(:,:,:,:)
@@ -151 +155 @@
           ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm))
           ALLOCATE(d%edge_assign_sign(0:5,d%iim,d%jjm))
+          ALLOCATE(d%vertex_assign_domain(0:5,d%iim,d%jjm))
+          ALLOCATE(d%vertex_assign_i(0:5,d%iim,d%jjm))
+          ALLOCATE(d%vertex_assign_j(0:5,d%iim,d%jjm))
+          ALLOCATE(d%vertex_assign_pos(0:5,d%iim,d%jjm))
           ALLOCATE(d%delta(d%iim,d%jjm))
           ALLOCATE(d%xyz(3,d%iim,d%jjm))
@@ -193 +201 @@
     d2%edge_assign_pos => d1%edge_assign_pos
     d2%edge_assign_sign => d1%edge_assign_sign
+    d2%vertex_assign_domain => d1%vertex_assign_domain
+    d2%vertex_assign_i => d1%vertex_assign_i
+    d2%vertex_assign_j => d1%vertex_assign_j
+    d2%vertex_assign_pos => d1%vertex_assign_pos
     d2%xyz => d1%xyz
     d2%neighbour => d1%neighbour
@@ -231 +243 @@
   USE metric
   IMPLICIT NONE
-    INTEGER :: ind_d,ind,ind2,e
+    INTEGER :: ind_d,ind,ind2,e,v
     INTEGER :: nf,nf2
     INTEGER :: i,j,k,ii,jj
@@ -258 +270 @@
           IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4)
           IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5)
+
+          IF ( i+1 <= d%ii_end .AND. j+1 <= d%jj_end)  CALL assign_vertex(ind_d,ind,i,j,delta,0)
+          IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end)  CALL assign_vertex(ind_d,ind,i,j,delta,1)
+          IF ( i-1 >= d%ii_begin .AND.  j+1 <= d%jj_end)  CALL assign_vertex(ind_d,ind,i,j,delta,2)
+          IF ( i-1 >= d%ii_begin .AND.  j-1 >= d%jj_begin)  CALL assign_vertex(ind_d,ind,i,j,delta,3)
+          IF ( i+1 <= d%ii_end .AND.  j-1 >= d%jj_begin)  CALL assign_vertex(ind_d,ind,i,j,delta,4)
+          IF ( i+1 <= d%ii_end .AND.  j-1 >= d%jj_begin)  CALL assign_vertex(ind_d,ind,i,j,delta,5)
         ENDDO
       ENDDO
@@ -294 +313 @@
               d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j)
             ENDIF
+
+            v=cell_glo(ind)%vertex(MOD(k+delta+6,6))
+            d%vertex_assign_domain(k,i,j)=vertices_glo(v)%assign_domain
+            d%vertex_assign_i(k,i,j)=vertices_glo(v)%assign_i
+            d%vertex_assign_j(k,i,j)=vertices_glo(v)%assign_j
+            d%vertex_assign_pos(k,i,j)=vertices_glo(v)%assign_pos
              
           ENDDO
@@ -318 +343 @@
       edge_glo(e)%assign_delta=delta
 
-     END  SUBROUTINE assign_edge
+    END  SUBROUTINE assign_edge
+ 
+    SUBROUTINE assign_vertex(ind_d,ind,i,j,delta,k)
+      INTEGER :: ind_d,ind,i,j,delta,k
+      INTEGER :: e
+      
+        e=cell_glo(ind)%vertex(MOD(k+delta+6,6))
+        vertices_glo(e)%assign_domain=ind_d
+        vertices_glo(e)%assign_i=i
+        vertices_glo(e)%assign_j=j
+        vertices_glo(e)%assign_pos=k
+        vertices_glo(e)%assign_delta=delta
+     
+    END  SUBROUTINE assign_vertex
+              
+  END SUBROUTINE assign_cell
          
-  END SUBROUTINE assign_cell
-
   SUBROUTINE compute_boundary
   USE spherical_geom_mod