Changeset 21 for codes/icosagcm/trunk/src/domain.f90

Timestamp:

07/18/12 11:15:39 (12 years ago)

Author:

ymipsl

Message:

correction for compiling with gfortran (line too long)
improvement for splitting domain
Call twice transfert request for field u is no longer necessary

YM

File:

• codes/icosagcm/trunk/src/domain.f90 (modified) (11 diffs)

codes/icosagcm/trunk/src/domain.f90

@@ -19 +19 @@
     INTEGER,POINTER  :: assign_i(:,:)
     INTEGER,POINTER  :: assign_j(:,:)
+    INTEGER,POINTER  :: edge_assign_domain(:,:,:)
+    INTEGER,POINTER  :: edge_assign_i(:,:,:)
+    INTEGER,POINTER  :: edge_assign_j(:,:,:)
+    INTEGER,POINTER  :: edge_assign_pos(:,:,:)
     REAL,POINTER     :: xyz(:,:,:)
     REAL,POINTER     :: neighbour(:,:,:,:)
@@ -71 +75 @@
     ind=0
     DO nf=1,nb_face
-      DO nj=1,nsplit_i
-        DO ni=1,nsplit_j
+      DO nj=1,nsplit_j
+        DO ni=1,nsplit_i
           ind=ind+1
           d=>domain(ind)
@@ -85 +89 @@
           ENDIF
           d%ii_end_glo=d%ii_begin_glo+d%ii_nb-1
+ 
+          IF (ni/=nsplit_i) THEN 
+            d%ii_nb=d%ii_nb+1
+            d%ii_end_glo=d%ii_end_glo+1
+          ENDIF
+         
         
           quotient=(jjm_glo/nsplit_j)
@@ -95 +105 @@
             d%jj_begin_glo=(quotient+1)*rest+(nj-1-rest) * quotient+1
           ENDIF
-
           d%jj_end_glo=d%jj_begin_glo+d%jj_nb-1
+
+          IF (nj/=nsplit_j) THEN 
+            d%jj_nb=d%jj_nb+1
+            d%jj_end_glo=d%jj_end_glo+1
+          ENDIF
+
+
           d%iim=d%ii_nb+2*halo
           d%jjm=d%jj_nb+2*halo
@@ -107 +123 @@
           ALLOCATE(d%assign_i(d%iim,d%jjm))
           ALLOCATE(d%assign_j(d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_domain(0:5,d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_i(0:5,d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_j(0:5,d%iim,d%jjm))
+          ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm))
           ALLOCATE(d%delta(d%iim,d%jjm))
           ALLOCATE(d%xyz(3,d%iim,d%jjm))
@@ -123 +143 @@
   USE metric
   IMPLICIT NONE
-    INTEGER :: ind_d,ind,ind2
+    INTEGER :: ind_d,ind,ind2,e
     INTEGER :: nf
     INTEGER :: i,j,k,ii,jj
     TYPE(t_domain),POINTER :: d
+    INTEGER :: delta
      
     
@@ -137 +158 @@
           jj=d%jj_begin_glo-d%jj_begin+j
           ind=vertex_glo(ii,jj,nf)%ind
+          delta=vertex_glo(ii,jj,nf)%delta
           IF (cell_glo(ind)%assign_face==nf) THEN 
             cell_glo(ind)%assign_domain=ind_d
@@ -142 +164 @@
             cell_glo(ind)%assign_j=j
           ENDIF
+          IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0)
+          IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1)
+          IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2)
+          IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3)
+          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)
         ENDDO
       ENDDO
     ENDDO
+    
     
     DO ind_d=1,ndomain
@@ -157 +186 @@
           d%assign_i(i,j)=cell_glo(ind)%assign_i
           d%assign_j(i,j)=cell_glo(ind)%assign_j
+          delta=vertex_glo(ii,jj,nf)%delta
           d%delta(i,j)=vertex_glo(ii,jj,nf)%delta
           DO k=0,5
@@ -162 +192 @@
             d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:)
             d%ne(k,i,j)=vertex_glo(ii,jj,nf)%ne(k)
+            e=cell_glo(ind)%edge(MOD(k+delta+6,6))
+            d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain
+            d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i
+            d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j
+            d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos
           ENDDO
           d%xyz(:,i,j)=cell_glo(ind)%xyz(:)
@@ -171 +206 @@
         ENDDO
       ENDDO
-    ENDDO    
+    ENDDO
+
+  CONTAINS
+
+    SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k)
+      INTEGER :: ind_d,ind,i,j,delta,k
+      INTEGER :: e
+      e=cell_glo(ind)%edge(MOD(k+delta+6,6))
+      edge_glo(e)%assign_domain=ind_d
+      edge_glo(e)%assign_i=i
+      edge_glo(e)%assign_j=j
+      edge_glo(e)%assign_pos=k
+!      PRINT*,"Assign_edge",ind_d,ind,i,j,k,e
+     END  SUBROUTINE assign_edge
+         
   END SUBROUTINE assign_cell