Changeset 397 for codes/icosagcm/trunk/src/observable.f90

Timestamp:

06/06/16 20:41:52 (8 years ago)

Author:

ymipsl

Message:

Prepare DCMIP2016 output by XIOS2

YM

File:

• codes/icosagcm/trunk/src/observable.f90 (modified) (5 diffs)

codes/icosagcm/trunk/src/observable.f90

@@ -10 +10 @@
   TYPE(t_field),POINTER, SAVE :: f_buf1_i(:), f_buf2_i(:)
   TYPE(t_field),POINTER, SAVE :: f_buf_v(:), f_buf_s(:), f_buf_p(:)
+  TYPE(t_field),POINTER, SAVE :: f_pmid(:)
 
 ! temporary shared variable for caldyn
@@ -15 +16 @@
 
   PUBLIC init_observable, write_output_fields_basic, f_theta
-
+  LOGICAL,SAVE :: first_output=.TRUE.
+!$OMP THREADPRIVATE(first_output)
+  
 CONTAINS
   
   SUBROUTINE init_observable
     CALL allocate_field(f_buf_i,   field_t,type_real,llm,name="buffer_i")
+    CALL allocate_field(f_buf1_i,   field_t,type_real,llm,name="buffer1_i")
+    CALL allocate_field(f_buf2_i,   field_t,type_real,llm,name="buffer2_i")
     CALL allocate_field(f_buf_p,   field_t,type_real,llm+1) 
     CALL allocate_field(f_buf_u3d, field_t,type_real,3,llm)  ! 3D vel at cell centers
@@ -29 +34 @@
 
     CALL allocate_field(f_theta, field_t,type_real,llm,  name='theta')   ! potential temperature
+    CALL allocate_field(f_pmid,  field_t,type_real,llm,  name='pmid')   ! mid layer pressure
   END SUBROUTINE init_observable
   
-  SUBROUTINE write_output_fields_basic(f_ps, f_mass, f_geopot, f_u, f_W, f_q)
+  SUBROUTINE write_output_fields_basic(f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q)
     USE wind_mod
     USE output_field_mod
     USE omp_para
-    TYPE(t_field),POINTER :: f_ps(:), f_mass(:), f_geopot(:), f_u(:), f_W(:), f_q(:)
+    USE time_mod
+    USE xios
+    USE disvert_mod
+    USE earth_const
+    USE pression_mod
+    USE vertical_interp_mod
+    USE theta2theta_rhodz_mod
+    USE wind_mod
+    USE omega_mod
+    
+    TYPE(t_field),POINTER :: f_ps(:), f_mass(:), f_geopot(:), f_theta_rhodz(:), f_u(:), f_W(:), f_q(:)
 !    IF (is_master) PRINT *,'CALL write_output_fields_basic'
+    REAL :: scalar(1)
+    REAL :: mid_ap(llm)
+    REAL :: mid_bp(llm)
+    INTEGER :: l
+
+    IF (first_output) THEN
+      scalar(1)=dt
+      CALL xios_send_field("timestep", scalar)
+      scalar(1)=preff
+      CALL xios_send_field("preff", scalar)
+      CALL xios_send_field("ap",ap)
+      CALL xios_send_field("bp",bp)
+      DO l=1,llm
+        mid_ap(l)=(ap(l)+ap(l+1))/2
+        mid_bp(l)=(bp(l)+bp(l+1))/2
+      ENDDO
+      CALL xios_send_field("mid_ap",mid_ap)
+      CALL xios_send_field("mid_bp",mid_bp)
+        
+      first_output=.FALSE.
+    ENDIF
+    
     CALL progonostic_vel_to_horiz(f_geopot, f_ps, f_mass, f_u, f_W, f_buf_uh, f_buf_i)
     CALL transfert_request(f_buf_uh,req_e1_vect) 
     CALL output_field("uz",f_buf_i)
+    CALL vertical_interp(f_ps,f_buf_i,f_buf_s,85000.)
+    CALL output_field("w850",f_buf_s)
+    CALL vertical_interp(f_ps,f_buf_i,f_buf_s,50000.)
+    CALL output_field("w500",f_buf_s)
+    
+    
     CALL un2ulonlat(f_buf_uh, f_buf_ulon, f_buf_ulat)
     CALL output_field("ulon",f_buf_ulon)
@@ -45 +89 @@
     CALL output_field("ps",f_ps)
     CALL output_field("Ai",geom%Ai)
+
     !       CALL output_field("dps",f_dps)
     CALL output_field("mass",f_mass)
@@ -50 +95 @@
     !       CALL output_field("dmass",f_dmass)
     !       CALL output_field("vort",f_qv)
-    CALL output_field("theta",f_theta)
+    
+    
+    CALL theta_rhodz2temperature(f_ps,f_theta_rhodz,f_buf_i) ; 
+    CALL Tv2T(f_buf_i,f_q,f_buf1_i) 
+    CALL output_field("temp",f_buf_i)
+    CALL vertical_interp(f_ps,f_buf_i,f_buf_s,85000.)
+    CALL output_field("t850",f_buf_s)
+    CALL vertical_interp(f_ps,f_buf_i,f_buf_s,50000.)
+    CALL output_field("t500",f_buf_s)
+    CALL vertical_interp(f_ps,f_buf_i,f_buf_s,preff)
+    CALL output_field("SST",f_buf_s)
+
+
+    CALL extract_slice(f_theta_rhodz, f_buf_i,1)
+    CALL output_field("theta",f_buf_i)
+           
     !       CALL output_field("exner",f_pk)
     !       CALL output_field("pv",f_qv)
     CALL output_field("q",f_q)
+    CALL pression_mid(f_ps, f_pmid)
+    CALL output_field("p",f_pmid)
+
+    CALL vertical_interp(f_ps,f_buf_ulon,f_buf_s,85000.)
+    CALL output_field("u850",f_buf_s)
+    CALL vertical_interp(f_ps,f_buf_ulon,f_buf_s,50000.)
+    CALL output_field("u500",f_buf_s)
+
+    CALL vertical_interp(f_ps,f_buf_ulat,f_buf_s,85000.)
+    CALL output_field("v850",f_buf_s)
+    CALL vertical_interp(f_ps,f_buf_ulat,f_buf_s,50000.)
+    CALL output_field("v500",f_buf_s)
+    
+    CALL w_omega(f_ps, f_u, f_buf_i)
+    CALL output_field("omega",f_buf_i)
+    CALL vertical_interp(f_ps,f_buf_i,f_buf_s,85000.)
+    CALL output_field("omega850",f_buf_s)
+    CALL vertical_interp(f_ps,f_buf_i,f_buf_s,50000.)
+    CALL output_field("omega500",f_buf_s)
+
+
+    
   END SUBROUTINE write_output_fields_basic