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

Timestamp:

07/26/12 15:25:40 (12 years ago)

Author:

ymipsl

Message:

Implementation of parallelism
implementation of iterative laplacian for dissipation

File:

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

codes/icosagcm/trunk/src/domain.f90

@@ -59 +59 @@
   TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain(:)
   INTEGER :: ndomain
-
-
+  TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain_glo(:)
+  INTEGER :: ndomain_glo
+
+  INTEGER,ALLOCATABLE,SAVE :: domglo_rank(:)
+  INTEGER,ALLOCATABLE,SAVE :: domglo_loc_ind(:)
+  INTEGER,ALLOCATABLE,SAVE :: domloc_glo_ind(:)
+  
 CONTAINS
 
@@ -70 +75 @@
   TYPE(t_domain),POINTER :: d
  
-    ndomain=nsplit_i*nsplit_j*nb_face
-    ALLOCATE(domain(ndomain))
-  
+    ndomain_glo=nsplit_i*nsplit_j*nb_face
+    ALLOCATE(domain_glo(ndomain_glo))
+    ALLOCATE(domglo_rank(ndomain_glo))
+    ALLOCATE(domglo_loc_ind(ndomain_glo))
+
     ind=0
     DO nf=1,nb_face
@@ -78 +85 @@
         DO ni=1,nsplit_i
           ind=ind+1
-          d=>domain(ind)
+          d=>domain_glo(ind)
           quotient=(iim_glo/nsplit_i)
           rest=MOD(iim_glo,nsplit_i)
@@ -139 +146 @@
   END SUBROUTINE create_domain
   
+  SUBROUTINE copy_domain(d1,d2)
+  IMPLICIT NONE
+  INTEGER :: face
+  TYPE(t_domain),TARGET,INTENT(IN) :: d1
+  TYPE(t_domain), INTENT(OUT) :: d2
+  
+    d2%iim = d1%iim
+    d2%jjm = d1%jjm
+    d2%ii_begin = d1%ii_begin
+    d2%jj_begin = d1%jj_begin
+    d2%ii_end = d1%ii_end
+    d2%jj_end = d1%jj_end
+    d2%ii_nb =  d1%ii_nb
+    d2%jj_nb = d1%jj_nb
+    d2%ii_begin_glo = d1%ii_begin_glo
+    d2%jj_begin_glo = d1%jj_begin_glo
+    d2%ii_end_glo = d1%ii_end_glo
+    d2%jj_end_glo = d1%jj_end_glo
+    d2%assign_domain => d1%assign_domain
+    d2%assign_i => d1%assign_i
+    d2%assign_j => d1%assign_j
+    d2%edge_assign_domain => d1%edge_assign_domain
+    d2%edge_assign_i => d1%edge_assign_i
+    d2%edge_assign_j => d1%edge_assign_j
+    d2%edge_assign_pos => d1%edge_assign_pos
+    d2%xyz => d1%xyz
+    d2%neighbour => d1%neighbour
+    d2%delta => d1%delta
+    d2%vertex => d1%vertex
+    d2%own => d1%own
+    d2%ne => d1%ne
+    
+    d2%t_right = d1%t_right
+    d2%t_rup = d1%t_rup
+    d2%t_lup = d1%t_lup
+    d2%t_left = d1%t_left
+    d2%t_ldown = d1%t_ldown
+    d2%t_rdown = d1%t_rdown
+
+    d2%u_right = d1%u_right
+    d2%u_rup = d1%u_rup
+    d2%u_lup = d1%u_lup
+    d2%u_left = d1%u_left
+    d2%u_ldown = d1%u_ldown
+    d2%u_rdown = d1%u_rdown
+
+    d2%z_rup = d1%z_rup
+    d2%z_up = d1%z_up
+    d2%z_lup = d1%z_lup
+    d2%z_ldown = d1%z_ldown
+    d2%z_down = d1%z_down
+    d2%z_rdown = d1%z_rdown
+   
+    d2%t_pos = d1%t_pos
+    d2%u_pos = d1%u_pos
+    d2%z_pos = d1%z_pos
+    
+  END SUBROUTINE copy_domain
+  
   
   SUBROUTINE assign_cell
@@ -150 +216 @@
      
     
-    DO ind_d=1,ndomain
-      d=>domain(ind_d)
+    DO ind_d=1,ndomain_glo
+      d=>domain_glo(ind_d)
       nf=d%face
       DO j=d%jj_begin,d%jj_end
@@ -175 +241 @@
     
     
-    DO ind_d=1,ndomain
-      d=>domain(ind_d)
+    DO ind_d=1,ndomain_glo
+      d=>domain_glo(ind_d)
       nf=d%face
       DO j=d%jj_begin-1,d%jj_end+1
@@ -231 +297 @@
     REAL(rstd) :: ng1(3),ng2(3) 
 
-    DO ind_d=1,ndomain
-      d=>domain(ind_d)
+    DO ind_d=1,ndomain_glo
+      d=>domain_glo(ind_d)
       DO j=d%jj_begin-1,d%jj_end+1
         DO i=d%ii_begin-1,d%ii_end+1
@@ -252 +318 @@
     TYPE(t_domain),POINTER :: d 
     
-    DO ind_d=1,ndomain
-      d=>domain(ind_d)
+    DO ind_d=1,ndomain_glo
+      d=>domain_glo(ind_d)
       d%t_right=1
       d%t_left=-1
@@ -301 +367 @@
   END SUBROUTINE set_neighbour_indice
       
-      
+  SUBROUTINE assign_domain
+  USE mpipara
+  IMPLICIT NONE
+    INTEGER :: nb_domain(0:mpi_size-1)
+    INTEGER :: rank, ind,ind_glo
+    
+    DO rank=0,mpi_size-1
+      nb_domain(rank)=ndomain_glo/mpi_size
+      IF ( rank < MOD(ndomain_glo,mpi_size) ) nb_domain(rank)=nb_domain(rank)+1
+    ENDDO
+    
+    ndomain=nb_domain(mpi_rank)
+    ALLOCATE(domain(ndomain))
+    ALLOCATE(domloc_glo_ind(ndomain))
+    
+    rank=0
+    ind=0
+    DO ind_glo=1,ndomain_glo
+      ind=ind+1
+      domglo_rank(ind_glo)=rank
+      domglo_loc_ind(ind_glo)=ind
+      IF (rank==mpi_rank) THEN 
+        CALL copy_domain(domain_glo(ind_glo),domain(ind))
+        domloc_glo_ind(ind)=ind_glo
+      ENDIF
+      
+      IF (ind==nb_domain(rank)) THEN
+        rank=rank+1
+        ind=0
+      ENDIF
+    ENDDO
+    
+  END SUBROUTINE  assign_domain      
+    
           
   SUBROUTINE compute_domain
   IMPLICIT NONE
-  
+    CALL init_domain_param
     CALL create_domain
     CALL assign_cell
     CALL compute_boundary
     CALL set_neighbour_indice
+    CALL assign_domain
       
   END SUBROUTINE compute_domain