Changeset 879 for codes/icosagcm/devel/src/parallel

Timestamp:

06/04/19 18:03:54 (5 years ago)

Author:

dubos

Message:

devel : introduced derived type to store cell bounds

File:

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

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

@@ -1 +1 @@
 MODULE domain_mod
   USE domain_param
+  IMPLICIT NONE
+  SAVE
+
+  TYPE t_cellset
+     ! derived type containing arrays for lat,lon of center and bounds of cells of primal or dual mesh
+     ! this information is needed to write CF-compliant NetCDF files
+     ! and by XIOS
+     INTEGER :: ncell
+     INTEGER, ALLOCATABLE :: ij(:), & ! ij(n) = local index of cell n
+          ind_glo(:), &  ! ind_glo(n) = global index of cell n
+          sgn(:)         ! sign to apply before writing to disk (velocities)
+     REAL, ALLOCATABLE :: lon(:), lat(:), bnds_lon(:,:), bnds_lat(:,:)
+  END type t_cellset
 
   TYPE t_domain
@@ -60 +73 @@
     INTEGER :: u_pos(6)
     INTEGER :: z_pos(6)
-     
+
+    TYPE(t_cellset), POINTER :: primal_own, dual_own, edge_own, &
+         primal_all, dual_all, edge_all ! halo included, used for debug by writefield
   END TYPE t_domain
 
-  INTEGER,SAVE :: ndomain
-  INTEGER,SAVE :: ndomain_glo
+  TYPE t_mesh
+     INTEGER :: ndomain, primal_num, edge_num, dual_num
+     TYPE(t_domain), ALLOCATABLE :: domain(:)
+     TYPE(t_cellset), ALLOCATABLE :: primal_own(:), dual_own(:), edge_own(:), &
+       primal_all(:), dual_all(:), edge_all(:)
+  END type t_mesh
+
+  INTEGER :: ndomain
+  INTEGER :: ndomain_glo
 
   LOGICAL :: swap_needed=.TRUE. ! .FALSE. if a thread always computes on the same domain
   !$OMP THREADPRIVATE(swap_needed)
 
-  TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain(:)
-  TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain_glo(:)
-
-  INTEGER,ALLOCATABLE,SAVE :: domglo_rank(:)  ! size : ndomain_glo : mpi rank assigned to a domain 
-  INTEGER,ALLOCATABLE,SAVE :: domglo_loc_ind(:) ! size : ndomain_glo : corresponding local indice for a global domain indice
-  INTEGER,ALLOCATABLE,SAVE :: domloc_glo_ind(:) ! size : ndomain : corresponding global indice for a local domain indice
-
-  LOGICAL, ALLOCATABLE, SAVE :: assigned_domain(:) ! size : ndomain : is an omp task is assigned to this domain
+  TYPE(t_mesh), TARGET :: mesh_loc, mesh_glo
+  TYPE(t_domain), POINTER :: domain(:), domain_glo(:)
+
+  INTEGER,ALLOCATABLE :: domglo_rank(:)  ! size : ndomain_glo : mpi rank assigned to a domain 
+  INTEGER,ALLOCATABLE :: domglo_loc_ind(:) ! size : ndomain_glo : corresponding local indice for a global domain indice
+  INTEGER,ALLOCATABLE :: domloc_glo_ind(:) ! size : ndomain : corresponding global indice for a local domain indice
+
+  LOGICAL, ALLOCATABLE :: assigned_domain(:) ! size : ndomain : is an omp task is assigned to this domain
 !$OMP THREADPRIVATE(assigned_domain)
     
 CONTAINS
+
+  SUBROUTINE allocate_mesh(ndom, mesh)
+    INTEGER, INTENT(IN)       :: ndom
+    TYPE(t_mesh), TARGET, INTENT(OUT) :: mesh
+    INTEGER :: ind
+    mesh%ndomain = ndom
+    ALLOCATE(mesh%domain(ndom))
+    ALLOCATE(mesh%primal_own(ndom))
+    ALLOCATE(mesh%primal_all(ndom))
+    ALLOCATE(mesh%dual_own(ndom))
+    ALLOCATE(mesh%dual_all(ndom))
+    ALLOCATE(mesh%edge_own(ndom))
+    ALLOCATE(mesh%edge_all(ndom))
+    DO ind=1, ndom
+       mesh%domain(ind)%primal_own => mesh%primal_own(ind)
+       mesh%domain(ind)%primal_all => mesh%primal_all(ind)
+       mesh%domain(ind)%dual_own => mesh%dual_own(ind)
+       mesh%domain(ind)%dual_all => mesh%dual_all(ind)
+       mesh%domain(ind)%edge_own => mesh%edge_own(ind)
+       mesh%domain(ind)%edge_all => mesh%edge_all(ind)
+    END DO
+  END SUBROUTINE allocate_mesh
 
   SUBROUTINE create_domain
@@ -85 +129 @@
   USE mpipara
   USE ioipsl
-  IMPLICIT NONE
   INTEGER :: ind,nf,ni,nj,i,j
   INTEGER :: quotient, rest
@@ -93 +136 @@
  
     ndomain_glo=nsplit_i*nsplit_j*nb_face
-    ALLOCATE(domain_glo(ndomain_glo))
+    CALL allocate_mesh(ndomain_glo, mesh_glo)
+    domain_glo => mesh_glo%domain
     ALLOCATE(domglo_rank(ndomain_glo))
     ALLOCATE(domglo_loc_ind(ndomain_glo))
@@ -178 +222 @@
   
   SUBROUTINE copy_domain(d1,d2)
-  IMPLICIT NONE
   INTEGER :: face
   TYPE(t_domain),TARGET,INTENT(IN) :: d1
@@ -245 +288 @@
   SUBROUTINE assign_cell
   USE metric
-  IMPLICIT NONE
     INTEGER :: ind_d,ind,ind2,e,v
     INTEGER :: nf,nf2
@@ -365 +407 @@
   SUBROUTINE compute_boundary
   USE spherical_geom_mod
-  IMPLICIT NONE
     INTEGER :: ind_d
     INTEGER :: i,j,k
@@ -388 +429 @@
   SUBROUTINE set_neighbour_indice
   USE metric
-  IMPLICIT NONE
     INTEGER :: ind_d
     TYPE(t_domain),POINTER :: d 
@@ -444 +484 @@
   USE mpipara
   USE grid_param
-  IMPLICIT NONE
     INTEGER :: nb_domain(0:mpi_size-1)
     INTEGER :: rank, ind,ind_glo
@@ -456 +495 @@
     
     ndomain=nb_domain(mpi_rank)
-    ALLOCATE(domain(ndomain))
+    
+    ! ALLOCATE(domain(ndomain))
+    CALL allocate_mesh(ndomain, mesh_loc)
+    domain => mesh_loc%domain
+
     ALLOCATE(domloc_glo_ind(ndomain))
     
@@ -588 +631 @@
   USE omp_para
   USE mpipara
-  IMPLICIT NONE
     INTEGER :: nb_domain
     INTEGER :: rank, ind, i
@@ -629 +671 @@
   SUBROUTINE compute_domain
     USE grid_param, ONLY : grid_type, grid_unst, grid_ico
-    IMPLICIT NONE
+    INTEGER :: ind
     SELECT CASE(grid_type)
     CASE(grid_unst)
        ! FIXME temporary, sequential hack
        ndomain_glo=1
-       ALLOCATE(domain_glo(ndomain_glo))
+       CALL allocate_mesh(ndomain_glo, mesh_glo)
+       domain_glo => mesh_glo%domain
        ALLOCATE(domglo_rank(ndomain_glo))
        ALLOCATE(domglo_loc_ind(ndomain_glo))
@@ -641 +684 @@
 
        ndomain=1
-       ALLOCATE(domain(ndomain))
+       CALL allocate_mesh(ndomain, mesh_loc)
+       domain => mesh_loc%domain
        ALLOCATE(domloc_glo_ind(ndomain))
        ALLOCATE(assigned_domain(ndomain))
@@ -658 +702 @@
        CALL assign_domain
     END SELECT
+
+!    ALLOCATE(primal_cells(ndomain))
+!    ALLOCATE(dual_cells(ndomain))
+!    ALLOCATE(primal_cells_single(ndomain))
+!    ALLOCATE(dual_cells_single(ndomain))
+!    DO ind=1, ndomain
+!       domain(ind)%primal_cells => primal_cells(ind)
+!       domain(ind)%dual_cells => dual_cells(ind)
+!       domain(ind)%primal_cells_single => primal_cells_single(ind)
+!       domain(ind)%dual_cells_single => dual_cells_single(ind)
+!    END DO
+
   END SUBROUTINE compute_domain