Changeset 728 for codes/icosagcm

Timestamp:

08/23/18 17:38:00 (6 years ago)

Author:

dubos

Message:

devel : diagnose consistent kinetic energy using new req_z1_scal (r711)

Location:

codes/icosagcm/devel/src/diagnostics

Files:

• kinetic.f90 (modified) (8 diffs)
• observable.f90 (modified) (2 diffs)

codes/icosagcm/devel/src/diagnostics/kinetic.f90

@@ -3 +3 @@
 PRIVATE
 
-PUBLIC :: kinetic, kinetic_v, kinetic_new, gradient
+PUBLIC :: kinetic, kinetic_new, gradient
 
 CONTAINS
@@ -18 +18 @@
   
     CALL transfert_request(f_ue,req_e1_vect)
-    CALL transfert_request(f_ue,req_e1_vect)
 
     DO ind=1,ndomain
@@ -26 +25 @@
       ue=f_ue(ind)
       Ki=f_Ki(ind)
-      CALL compute_kinetic(ue, Ki)
+      CALL compute_kinetic_trisk(ue, Ki)
     ENDDO  
   END SUBROUTINE kinetic
   
-  SUBROUTINE kinetic_new(f_ue,f_Ki)
+  SUBROUTINE kinetic_new(f_ue,f_Kv,f_Ki)
     USE icosa
     IMPLICIT NONE
     TYPE(t_field), POINTER :: f_ue(:)
+    TYPE(t_field), POINTER :: f_Kv(:)
     TYPE(t_field), POINTER :: f_Ki(:)
     
     REAL(rstd), POINTER :: ue(:,:)
+    REAL(rstd), POINTER :: Kv(:,:)
     REAL(rstd), POINTER :: Ki(:,:)
     INTEGER :: ind
     
-    CALL transfert_request(f_ue,req_e1_vect)
-    CALL transfert_request(f_ue,req_e1_vect)
-    
-    DO ind=1,ndomain
-       IF (.NOT. assigned_domain(ind)) CYCLE
-       CALL swap_dimensions(ind)
-       CALL swap_geometry(ind)
-       ue=f_ue(ind)
-       Ki=f_Ki(ind)
-       CALL compute_Ki_new(ue, Ki)
-    ENDDO
-  END SUBROUTINE kinetic_new
-  
-  SUBROUTINE kinetic_v(f_ue,f_Kv)
-  USE icosa
-  IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ue(:)
-    TYPE(t_field), POINTER :: f_Kv(:)
-  
-    REAL(rstd), POINTER :: ue(:,:)
-    REAL(rstd), POINTER :: Kv(:,:)
-    INTEGER :: ind
-  
-    CALL transfert_request(f_ue,req_e1_vect)
     CALL transfert_request(f_ue,req_e1_vect)
 
@@ -73 +50 @@
       Kv=f_Kv(ind)
       CALL compute_kv(ue, Kv)
-    ENDDO  
-  END SUBROUTINE kinetic_v
+    ENDDO
+    
+    CALL transfert_request(f_Kv,req_z1_scal)
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       Kv=f_Kv(ind)
+       Ki=f_Ki(ind)
+       CALL compute_Ki_from_Kv(Kv, Ki)
+    ENDDO
+  END SUBROUTINE kinetic_new
   
-  SUBROUTINE compute_kinetic(ue, Ki)
+  SUBROUTINE compute_kinetic_trisk(ue, Ki)
   USE icosa
   USE omp_para
@@ -99 +87 @@
       ENDDO
     ENDDO
-  END SUBROUTINE compute_kinetic
+  END SUBROUTINE compute_kinetic_trisk
   
   SUBROUTINE compute_kv(ue, Kv)
@@ -113 +101 @@
     
     DO l=ll_begin,ll_end
+      Kv(:,l)=0.
       DO ij=ij_begin,ij_end
           Kv(ij+z_up,l) = (radius**2/Av(ij+z_up))*(                         &
@@ -127 +116 @@
   END SUBROUTINE compute_kv
   
-  SUBROUTINE compute_Ki_new(ue, Ki)
+  SUBROUTINE compute_Ki_from_Kv(Kv, Ki)
     USE icosa
     USE omp_para
     IMPLICIT NONE
-    REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)
     REAL(rstd),INTENT(OUT):: Ki(iim*jjm,llm)
-    REAL(rstd) :: Kv(2*iim*jjm,llm)
-    INTEGER :: ij,l, u_up, u_down
-    
-    CALL compute_kv(ue,Kv)
+    REAL(rstd), INTENT(IN) :: Kv(2*iim*jjm,llm)
+    INTEGER :: ij,l
     
     DO l=ll_begin,ll_end
@@ -148 +134 @@
        END DO
     END DO
-  END SUBROUTINE compute_Ki_new
+  END SUBROUTINE compute_Ki_from_Kv
   
   SUBROUTINE gradient(f_berni, f_du)

codes/icosagcm/devel/src/diagnostics/observable.f90

@@ -46 +46 @@
     USE theta2theta_rhodz_mod
     USE omega_mod
+    USE kinetic_mod
+
     LOGICAL, INTENT(IN) :: init
     INTEGER :: l
@@ -155 +157 @@
        CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,50000.)
        CALL output_field("omega500",f_buf_s)
+    END IF
+
+    CALL kinetic(f_u, f_buf_i)
+    IF(init) THEN
+       CALL output_field("kinetic_trisk_init",f_buf_i)
+    ELSE
+       CALL output_field("kinetic_trisk",f_buf_i)
+    END IF
+
+    CALL kinetic_new(f_u, f_buf_v, f_buf_i)
+    IF(init) THEN
+       CALL output_field("kinetic_init",f_buf_i)
+    ELSE
+       CALL output_field("kinetic",f_buf_i)
     END IF