Changeset 201 for codes/icosagcm/trunk/src/etat0.f90

Timestamp:

07/08/14 15:03:32 (10 years ago)

Author:

dubos

Message:

Simplified etat0 : isothermal, jablonowsky06

File:

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

codes/icosagcm/trunk/src/etat0.f90

@@ -13 +13 @@
   
   SUBROUTINE etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q)
-    USE icosa
     USE mpipara, ONLY : is_mpi_root
     USE disvert_mod
@@ -54 +53 @@
     CASE ('isothermal')
        CALL getin_etat0_isothermal
-       CALL etat0_collocated(init_mass, f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
+       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
     CASE ('williamson91.6')
        init_mass=.FALSE.
        CALL etat0_williamson_new(f_phis,f_mass,f_theta_rhodz,f_u, f_q)
     CASE ('jablonowsky06')
-       CALL etat0_jablonowsky06(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
+!       CALL etat0_jablonowsky06(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
+       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
     CASE ('academic')
        CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
@@ -106 +106 @@
   END SUBROUTINE etat0
 
-  SUBROUTINE etat0_collocated(init_mass, f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q)
+  SUBROUTINE etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
+    USE mpipara
     IMPLICIT NONE
-    LOGICAL, INTENT(IN) :: init_mass
     TYPE(t_field),POINTER :: f_ps(:)
     TYPE(t_field),POINTER :: f_mass(:)
@@ -134 +134 @@
       u=f_u(ind)
       q=f_q(ind)
-      CALL compute_etat0_collocated(init_mass, ps,mass, phis, theta_rhodz, u, q)
+      CALL compute_etat0_collocated(ps,mass, phis, theta_rhodz, u, q)
+
     ENDDO
   END SUBROUTINE etat0_collocated
 
-  SUBROUTINE compute_etat0_collocated(init_mass, ps,mass, phis, theta_rhodz, u, q)
-    USE icosa
+  SUBROUTINE compute_etat0_collocated(ps,mass, phis, theta_rhodz, u, q)
     USE disvert_mod
     USE theta2theta_rhodz_mod
     USE wind_mod
+    USE etat0_jablonowsky06_mod, ONLY : compute_jablonowsky06 => compute_etat0_new
     IMPLICIT NONE
-    LOGICAL, INTENT(IN) :: init_mass
     REAL(rstd),INTENT(INOUT) :: ps(iim*jjm)
     REAL(rstd),INTENT(INOUT) :: mass(iim*jjm,llm)
@@ -182 +182 @@
     END DO
 
-    CALL compute_etat0_ngrid(iim*jjm,lon_i,lat_i, phis, ps, mass, temp_i, ulon_i, ulat_i, q)
-    IF(init_mass) THEN
-       CALL compute_rhodz(.TRUE., ps, mass)
-    END IF
-    CALL compute_temperature2theta_rhodz(ps,temp_i,theta_rhodz,0) ! FIXME - works with shallow-water ?
-
-    CALL compute_etat0_ngrid(3*iim*jjm,lon_e,lat_e, phis_e,ps_e,mass_e, temp_e, ulon_e, ulat_e, q_e)
-    CALL compute_wind_from_lonlat_compound(ulon_e, ulat_e, u)
-
-  END SUBROUTINE compute_etat0_collocated
-
-  SUBROUTINE compute_etat0_ngrid(ngrid,lon,lat, phis, ps, mass, temp, ulon, ulat, q)
-    IMPLICIT NONE  
-    INTEGER, INTENT(IN)    :: ngrid
-    REAL(rstd),INTENT(IN)  :: lon(ngrid)
-    REAL(rstd),INTENT(IN)  :: lat(ngrid)
-    REAL(rstd),INTENT(OUT) :: phis(ngrid)
-    REAL(rstd),INTENT(INOUT) :: ps(ngrid)
-    REAL(rstd),INTENT(INOUT) :: mass(ngrid,llm)
-    REAL(rstd),INTENT(OUT) :: temp(ngrid,llm)
-    REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm)
-    REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm)
-    REAL(rstd),INTENT(OUT) :: q(ngrid,llm,nqtot)
-
     SELECT CASE (TRIM(etat0_type))
     CASE ('isothermal')
-       CALL compute_etat0_isothermal(ngrid, phis, ps, temp, ulon, ulat, q)
+       CALL compute_etat0_isothermal(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
+       CALL compute_etat0_isothermal(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
+    CASE('jablonowsky06')
+       CALL compute_jablonowsky06(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i)
+       CALL compute_jablonowsky06(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e)
     END SELECT
 
-  END SUBROUTINE compute_etat0_ngrid
+    CALL compute_temperature2theta_rhodz(ps,temp_i,theta_rhodz,0)       
+    CALL compute_wind_perp_from_lonlat_compound(ulon_e, ulat_e, u)
+
+  END SUBROUTINE compute_etat0_collocated
 
 !----------------------------- Resting isothermal state --------------------------------
 
   SUBROUTINE getin_etat0_isothermal
-    etat0_temp=300;
-    CALL getin("etat0_temp",etat0_temp)
+    etat0_temp=300
+    CALL getin("etat0_isothermal_temp",etat0_temp)
   END SUBROUTINE getin_etat0_isothermal