Changeset 396

Timestamp:

06/06/16 20:40:35 (8 years ago)

Author:

ymipsl

Message:

New field function : extract_slice and insert_slice

YM

File:

• codes/icosagcm/trunk/src/field.f90 (modified) (1 diff)

codes/icosagcm/trunk/src/field.f90

@@ -302 +302 @@
   END SUBROUTINE deallocate_field_glo
     
+  SUBROUTINE extract_slice(field_in, field_out, l)  
+  USE domain_mod
+  USE omp_para
+  IMPLICIT NONE  
+    TYPE(t_field) :: field_in(:)
+    TYPE(t_field) :: field_out(:)
+    INTEGER,INTENT(IN) :: l
+    
+    INTEGER :: ind
+    INTEGER :: data_type
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      data_type=field_in(ind)%data_type
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+      
+      IF (field_in(ind)%ndim==3 .AND. field_out(ind)%ndim==2) THEN  
+        IF (data_type==type_integer)  field_out(ind)%ival2d=field_in(ind)%ival3d(:,l)
+        IF (data_type==type_real)     field_out(ind)%rval2d=field_in(ind)%rval3d(:,l)
+        IF (data_type==type_logical)  field_out(ind)%lval2d=field_in(ind)%lval3d(:,l)
+      ELSE IF  (field_in(ind)%ndim==4 .AND. field_out(ind)%ndim==3) THEN
+        IF (data_type==type_integer)  field_out(ind)%ival3d=field_in(ind)%ival4d(:,:,l)
+        IF (data_type==type_real)     field_out(ind)%rval3d=field_in(ind)%rval4d(:,:,l)
+        IF (data_type==type_logical)  field_out(ind)%lval3d=field_in(ind)%lval4d(:,:,l)
+      ELSE
+        PRINT *, 'extract_slice : cannot extract slice, dimension incompatible'
+        STOP       
+      ENDIF
+   ENDDO 
+!$OMP BARRIER    
+  END  SUBROUTINE extract_slice  
+  
+  
+  SUBROUTINE insert_slice(field_in, field_out, l)  
+  USE domain_mod
+  USE omp_para
+  IMPLICIT NONE  
+    TYPE(t_field) :: field_in(:)
+    TYPE(t_field) :: field_out(:)
+    INTEGER,INTENT(IN) :: l
+    
+    INTEGER :: ind
+    INTEGER :: data_type
+
+!$OMP BARRIER
+    DO ind=1,ndomain
+      data_type=field_in(ind)%data_type
+      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE
+      
+      IF (field_in(ind)%ndim==2 .AND. field_out(ind)%ndim==3) THEN  
+        IF (data_type==type_integer)  field_out(ind)%ival3d(:,l)=field_in(ind)%ival2d(:)
+        IF (data_type==type_real)     field_out(ind)%rval3d(:,l)=field_in(ind)%rval2d(:)
+        IF (data_type==type_logical)  field_out(ind)%lval3d(:,l)=field_in(ind)%lval2d(:)
+      ELSE IF  (field_in(ind)%ndim==4 .AND. field_out(ind)%ndim==3) THEN
+        IF (data_type==type_integer)  field_out(ind)%ival4d(:,:,l)=field_out(ind)%ival3d(:,:)
+        IF (data_type==type_real)     field_out(ind)%rval4d(:,:,l)=field_out(ind)%rval3d(:,:)
+        IF (data_type==type_logical)  field_out(ind)%lval4d(:,:,l)=field_out(ind)%lval3d(:,:)
+      ELSE
+        PRINT *, 'extract_slice : cannot insert slice, dimension incompatible'
+        STOP       
+      ENDIF
+   ENDDO 
+!$OMP BARRIER    
+  
+  END SUBROUTINE insert_slice
+    
   SUBROUTINE getval_r2d(field_pt,field)
   IMPLICIT NONE