Changeset 110 for codes/icosagcm/trunk/src/caldyn_gcm.f90

Timestamp:

08/07/12 19:10:05 (12 years ago)

Author:

ymipsl

Message:

Correction for dcmip moist physics
Temperature is ouput instead of virtual temperature.

YM

File:

• codes/icosagcm/trunk/src/caldyn_gcm.f90 (modified) (7 diffs)

codes/icosagcm/trunk/src/caldyn_gcm.f90

@@ -74 +74 @@
   END SUBROUTINE check_mass_conservation
   
-  SUBROUTINE caldyn(it,f_phis, f_ps, f_theta_rhodz, f_u, f_dps, f_dtheta_rhodz, f_du)
+  SUBROUTINE caldyn(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q, f_dps, f_dtheta_rhodz, f_du)
   USE icosa
   USE vorticity_mod
@@ -85 +85 @@
   TYPE(t_field),POINTER :: f_theta_rhodz(:)
   TYPE(t_field),POINTER :: f_u(:)
+  TYPE(t_field),POINTER :: f_q(:)
   TYPE(t_field),POINTER :: f_dps(:)
   TYPE(t_field),POINTER :: f_dtheta_rhodz(:)
@@ -123 +124 @@
     IF (mod(it,itau_out)==0 ) THEN
        PRINT *,'CALL write_output_fields'
-       CALL write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, &
+       CALL write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, f_q, &
             f_buf_i, f_buf_v, f_buf_u3d, f_buf_ulon, f_buf_ulat, f_buf_s, f_buf_p)
     END IF
@@ -626 +627 @@
   END SUBROUTINE compute_caldyn
   
-  SUBROUTINE write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, &
+  SUBROUTINE write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, f_q, &
        f_buf_i, f_buf_v, f_buf_i3, f_buf1_i, f_buf2_i, f_buf_s, f_buf_p)
     USE icosa
@@ -635 +636 @@
     USE write_field
     USE vertical_interp_mod
-    TYPE(t_field),POINTER :: f_ps(:), f_phis(:), f_u(:), f_theta_rhodz(:), f_dps(:), &
+    TYPE(t_field),POINTER :: f_ps(:), f_phis(:), f_u(:), f_theta_rhodz(:), f_q(:), f_dps(:), &
          f_buf_i(:), f_buf_v(:), f_buf_i3(:), f_buf1_i(:), f_buf2_i(:), f_buf_s(:), f_buf_p(:)
     
     REAL(rstd) :: out_pression_lev
     CHARACTER(LEN=255) :: str_pression
+    CHARACTER(LEN=255) :: physics_type
     
     out_pression_level=0
@@ -661 +663 @@
     ! Temperature
     CALL theta_rhodz2temperature(f_ps,f_theta_rhodz,f_buf_i) ;
-    CALL writefield("T",f_buf_i)
-    
-    IF (out_pression_level<=preff .AND. out_pression_level > 0) THEN
-      CALL vertical_interp(f_ps,f_buf_i,f_buf_s,out_pression_level)
-      CALL writefield("T"//TRIM(str_pression),f_buf_s)
+    
+    CALL getin('physics',physics_type)
+    IF (TRIM(physics_type)=='dcmip') THEN
+      CALL Tv2T(f_buf_i,f_q,f_buf1_i) 
+      CALL writefield("T",f_buf1_i)
+      IF (out_pression_level<=preff .AND. out_pression_level > 0) THEN
+        CALL vertical_interp(f_ps,f_buf1_i,f_buf_s,out_pression_level)
+        CALL writefield("T"//TRIM(str_pression),f_buf_s)
+      ENDIF
+    ELSE
+      CALL writefield("T",f_buf_i)
+      IF (out_pression_level<=preff .AND. out_pression_level > 0) THEN
+        CALL vertical_interp(f_ps,f_buf_i,f_buf_s,out_pression_level)
+        CALL writefield("T"//TRIM(str_pression),f_buf_s)
+      ENDIF
     ENDIF
-    
+   
     ! velocity components
     CALL un2ulonlat(f_u, f_buf_i3, f_buf1_i, f_buf2_i)
@@ -739 +751 @@
     END DO
   END SUBROUTINE un2ulonlat
- 
+
+  SUBROUTINE Tv2T(f_Tv, f_q, f_T)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_TV(:)
+    TYPE(t_field), POINTER :: f_q(:)
+    TYPE(t_field), POINTER :: f_T(:)
+    
+    REAL(rstd),POINTER :: Tv(:,:), q(:,:,:), T(:,:)
+    INTEGER :: ind
+    
+    DO ind=1,ndomain
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       Tv=f_Tv(ind)
+       q=f_q(ind)
+       T=f_T(ind)
+       T=Tv/(1+0.608*q(:,:,1))
+    END DO
+    
+  END SUBROUTINE Tv2T
+  
 END MODULE caldyn_gcm_mod