Index: /codes/icosagcm/devel/src/base/field.f90
===================================================================
--- /codes/icosagcm/devel/src/base/field.f90	(revision 861)
+++ /codes/icosagcm/devel/src/base/field.f90	(revision 862)
@@ -44,5 +44,5 @@
   END INTERFACE
 
-  PRIVATE :: allocate_field_
+  PRIVATE :: allocate_field_, deallocate_field_
 
 CONTAINS
@@ -61,5 +61,6 @@
 !$OMP END MASTER
 !$OMP BARRIER
-    CALL allocate_field_(field,field_type,data_type,dim1,dim2,name)
+    CALL allocate_field_(domain,assigned_domain, field,field_type,data_type,dim1,dim2,name)
+!$OMP BARRIER
   END SUBROUTINE allocate_field
 
@@ -80,12 +81,33 @@
 !$OMP BARRIER
     DO i=1,nfield
-       CALL allocate_field_(field(:,i),field_type,data_type,dim1,dim2,name)
+       CALL allocate_field_(domain,assigned_domain, field(:,i),field_type,data_type,dim1,dim2,name)
     END DO
+!$OMP BARRIER
   END SUBROUTINE allocate_fields
 
-  SUBROUTINE allocate_field_(field,field_type,data_type,dim1,dim2,name)
+  SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2,name)
+    USE domain_mod
+    IMPLICIT NONE
+    TYPE(t_field),POINTER :: field(:)
+    INTEGER,INTENT(IN) :: field_type
+    INTEGER,INTENT(IN) :: data_type
+    INTEGER,OPTIONAL :: dim1,dim2
+    CHARACTER(*), OPTIONAL :: name
+    INTEGER :: ind
+    INTEGER :: ii_size,jj_size
+    LOGICAL :: assigned_dom(ndomain_glo)
+    ! ONLY the master thread is allowed to call this routine
+
+    ALLOCATE(field(ndomain_glo))    
+    assigned_dom(:)=.TRUE.
+    CALL allocate_field_(domain_glo,assigned_dom, field,field_type,data_type,dim1,dim2,name)  
+
+  END SUBROUTINE allocate_field_glo
+
+  SUBROUTINE allocate_field_(dom,assigned_dom, field,field_type,data_type,dim1,dim2,name) 
     USE domain_mod
     USE omp_para
-    USE grid_param
+    TYPE(t_domain), INTENT(IN) :: dom(:)
+    LOGICAL, INTENT(IN) :: assigned_dom(:)
     TYPE(t_field) :: field(:)
     INTEGER,INTENT(IN) :: field_type
@@ -94,8 +116,7 @@
     CHARACTER(*), OPTIONAL :: name
     INTEGER :: ind
-    INTEGER :: ij_size
-
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+
+    DO ind=1,SIZE(field)
+      IF (.NOT. assigned_dom(ind)  .OR. .NOT. is_omp_level_master) CYCLE
 
       IF(PRESENT(name)) THEN
@@ -114,127 +135,79 @@
       ELSE
         field(ind)%ndim=2
-      ENDIF
-    
+      END IF
     
       field(ind)%data_type=data_type
       field(ind)%field_type=field_type
-      
-      SELECT CASE(grid_type)
-         CASE(grid_ico)
-            ij_size=domain(ind)%iim
-            IF (field_type==field_T) THEN 
-               ij_size=ij_size*domain(ind)%jjm
-            ELSE IF (field_type==field_U) THEN 
-               ij_size=3*ij_size*domain(ind)%jjm
-            ELSE IF (field_type==field_Z) THEN 
-               ij_size=2*ij_size*domain(ind)%jjm
-            ENDIF     
-        
-            IF (field(ind)%ndim==4) THEN
-               IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ij_size,dim1,dim2))
-               IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ij_size,dim1,dim2))
-               IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ij_size,dim1,dim2))
-            ELSE IF (field(ind)%ndim==3) THEN
-               IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ij_size,dim1))
-               IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ij_size,dim1))
-               IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ij_size,dim1))
-            ELSE IF (field(ind)%ndim==2) THEN
-               IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ij_size))
-               IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ij_size))
-               IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ij_size))
-            ENDIF
-
-         CASE(grid_unst)
-            PRINT *, 'Allocating field ', field(ind)%name
-            IF (field_type==field_T) THEN 
-               ij_size=primal_num
-            ELSE IF (field_type==field_U) THEN 
-               ij_size=edge_num
-            ELSE IF (field_type==field_Z) THEN 
-               ij_size=dual_num
-            ENDIF     
-
-            IF (field(ind)%ndim==4) THEN
-               IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(dim1,ij_size,dim2))
-               IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(dim1,ij_size,dim2))
-               IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(dim1,ij_size,dim2))
-            ELSE IF (field(ind)%ndim==3) THEN
-               IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(dim1,ij_size))
-               IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(dim1,ij_size))
-               IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(dim1,ij_size))
-            ELSE IF (field(ind)%ndim==2) THEN
-               IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ij_size))
-               IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ij_size))
-               IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ij_size))
-            ENDIF
-
-         END SELECT
-      ENDDO
-!$OMP BARRIER
+
+      CALL allocate_field_XvalY(field(ind), dom(ind))
+     END DO
    
  END SUBROUTINE allocate_field_
 
-  SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2,name)
-  USE domain_mod
-  IMPLICIT NONE
-    TYPE(t_field),POINTER :: field(:)
-    INTEGER,INTENT(IN) :: field_type
-    INTEGER,INTENT(IN) :: data_type
-    INTEGER,OPTIONAL :: dim1,dim2
-    CHARACTER(*), OPTIONAL :: name
-    INTEGER :: ind
-    INTEGER :: ii_size,jj_size
-
-    ALLOCATE(field(ndomain_glo))    
-
-    DO ind=1,ndomain_glo
-  
-      IF (PRESENT(dim2)) THEN
-        field(ind)%ndim=4 
-        field(ind)%dim4=dim2 
-        field(ind)%dim3=dim1 
-      ELSE IF (PRESENT(dim1)) THEN
-        field(ind)%ndim=3
-        field(ind)%dim3=dim1 
-      ELSE
-        field(ind)%ndim=2
-      ENDIF
-    
-      IF(PRESENT(name)) THEN
-         field(ind)%name = name
-      ELSE
-         field(ind)%name = '(undefined)'
-      END IF
-    
-      field(ind)%data_type=data_type
-      field(ind)%field_type=field_type
-    
-      IF (field_type==field_T) THEN 
-        jj_size=domain_glo(ind)%jjm
-      ELSE IF (field_type==field_U) THEN 
-        jj_size=3*domain_glo(ind)%jjm
-      ELSE IF (field_type==field_Z) THEN 
-        jj_size=2*domain_glo(ind)%jjm
-      ENDIF
-      
-      ii_size=domain_glo(ind)%iim
-        
-      IF (field(ind)%ndim==4) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ii_size*jj_size,dim1,dim2))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ii_size*jj_size,dim1,dim2))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ii_size*jj_size,dim1,dim2))
-      ELSE IF (field(ind)%ndim==3) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ii_size*jj_size,dim1))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ii_size*jj_size,dim1))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ii_size*jj_size,dim1))
-      ELSE IF (field(ind)%ndim==2) THEN
-        IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ii_size*jj_size))
-        IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ii_size*jj_size))
-        IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ii_size*jj_size))
-      ENDIF
-      
-   ENDDO
-  
-  END SUBROUTINE allocate_field_glo
+  SUBROUTINE allocate_field_XvalY(field, dom)
+    USE domain_mod, ONLY : t_domain
+    USE grid_param
+    TYPE(t_field) :: field
+    TYPE(t_domain), INTENT(IN) :: dom
+    INTEGER :: data_type, dim1, dim2, ij_size
+    data_type = field%data_type
+    dim1      = field%dim3
+    dim2      = field%dim4
+    SELECT CASE(grid_type)
+    CASE(grid_ico)
+       ij_size=dom%iim
+       SELECT CASE(field%field_type)
+       CASE(field_T)
+          ij_size=ij_size*dom%jjm
+       CASE(field_U)
+          ij_size=3*ij_size*dom%jjm
+       CASE(field_Z)
+          ij_size=2*ij_size*dom%jjm
+       END SELECT
+       
+       IF (field%ndim==4) THEN
+          IF (data_type==type_integer) ALLOCATE(field%ival4d(ij_size,dim1,dim2))
+          IF (data_type==type_real)    ALLOCATE(field%rval4d(ij_size,dim1,dim2))
+          IF (data_type==type_logical) ALLOCATE(field%lval4d(ij_size,dim1,dim2))
+       ELSE IF (field%ndim==3) THEN
+          IF (data_type==type_integer) ALLOCATE(field%ival3d(ij_size,dim1))
+          IF (data_type==type_real)    ALLOCATE(field%rval3d(ij_size,dim1))
+          IF (data_type==type_logical) ALLOCATE(field%lval3d(ij_size,dim1))
+       ELSE IF (field%ndim==2) THEN
+          IF (data_type==type_integer) ALLOCATE(field%ival2d(ij_size))
+          IF (data_type==type_real)    ALLOCATE(field%rval2d(ij_size))
+          IF (data_type==type_logical) ALLOCATE(field%lval2d(ij_size))
+       ENDIF
+       
+    CASE(grid_unst)
+       PRINT *, 'Allocating field ', field%name
+       SELECT CASE(field%field_type)
+       CASE(field_T)
+          ij_size=primal_num
+       CASE(field_U)
+          ij_size=edge_num
+       CASE(field_Z)
+          ij_size=dual_num
+       END SELECT
+
+       PRINT *, 'Allocating field ', field%name
+       PRINT *, '          with ij_size = ', ij_size
+       
+       IF (field%ndim==4) THEN
+          IF (data_type==type_integer) ALLOCATE(field%ival4d(dim1,ij_size,dim2))
+          IF (data_type==type_real)    ALLOCATE(field%rval4d(dim1,ij_size,dim2))
+          IF (data_type==type_logical) ALLOCATE(field%lval4d(dim1,ij_size,dim2))
+       ELSE IF (field%ndim==3) THEN
+          IF (data_type==type_integer) ALLOCATE(field%ival3d(dim1,ij_size))
+          IF (data_type==type_real)    ALLOCATE(field%rval3d(dim1,ij_size))
+          IF (data_type==type_logical) ALLOCATE(field%lval3d(dim1,ij_size))
+       ELSE IF (field%ndim==2) THEN
+          IF (data_type==type_integer) ALLOCATE(field%ival2d(ij_size))
+          IF (data_type==type_real)    ALLOCATE(field%rval2d(ij_size))
+          IF (data_type==type_logical) ALLOCATE(field%lval2d(ij_size))
+       ENDIF
+       
+    END SELECT
+  END SUBROUTINE allocate_field_XvalY
 
   SUBROUTINE deallocate_field(field)
@@ -244,5 +217,5 @@
     TYPE(t_field),POINTER :: field(:)
     !$OMP BARRIER
-    CALL deallocate_field_(field)
+    CALL deallocate_field_(assigned_domain, field)
     !$OMP BARRIER
     !$OMP MASTER
@@ -260,5 +233,5 @@
     !$OMP BARRIER
     DO i=1,SIZE(field,2)
-       CALL deallocate_field_(field(:,i))
+       CALL deallocate_field_(assigned_domain, field(:,i))
     END DO
     !$OMP BARRIER
@@ -269,13 +242,13 @@
   END SUBROUTINE deallocate_fields
 
-  SUBROUTINE deallocate_field_(field)
-  USE domain_mod
+  SUBROUTINE deallocate_field_(assigned_dom, field)
   USE omp_para
-  IMPLICIT NONE
+    IMPLICIT NONE
+    LOGICAL, INTENT(IN) :: assigned_dom(:)
     TYPE(t_field) :: field(:)
     INTEGER :: data_type
     INTEGER :: ind
-    DO ind=1,ndomain
-      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+    DO ind=1,SIZE(field)
+      IF (.NOT. assigned_dom(ind)  .OR. .NOT. is_omp_level_master) CYCLE
 
       data_type=field(ind)%data_type
@@ -304,26 +277,8 @@
     INTEGER :: data_type
     INTEGER :: ind
-
-    DO ind=1,ndomain_glo
-
-      data_type=field(ind)%data_type
-        
-      IF (field(ind)%ndim==4) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival4d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval4d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval4d)
-      ELSE IF (field(ind)%ndim==3) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival3d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval3d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval3d)
-      ELSE IF (field(ind)%ndim==2) THEN
-        IF (data_type==type_integer) DEALLOCATE(field(ind)%ival2d)
-        IF (data_type==type_real)    DEALLOCATE(field(ind)%rval2d)
-        IF (data_type==type_logical) DEALLOCATE(field(ind)%lval2d)
-      ENDIF
-      
-   ENDDO
-   DEALLOCATE(field)
-       
+    LOGICAL :: assigned_dom(ndomain_glo)
+    ! ONLY the master thread is allowed to call this routine
+    CALL deallocate_field_(assigned_dom, field)
+    DEALLOCATE(field)       
   END SUBROUTINE deallocate_field_glo
     
