Changeset 741 for codes/icosagcm/devel/src/physics/physics.f90

Timestamp:

09/28/18 12:59:46 (6 years ago)

Author:

dubos

Message:

devel : added vertical diffusion to idealized venus physics

File:

• codes/icosagcm/devel/src/physics/physics.f90 (modified) (14 diffs)

codes/icosagcm/devel/src/physics/physics.f90

@@ -12 +12 @@
        phys_lmdz_generic=21, phys_external=22
   INTEGER :: phys_type
-  TYPE(t_field),POINTER,SAVE :: f_extra_physics_2D(:), f_extra_physics_3D(:)
   TYPE(t_field),POINTER,SAVE :: f_dulon(:), f_dulat(:)
   TYPE(t_field),POINTER,SAVE :: f_ulon(:), f_ulat(:)
@@ -50 +49 @@
     CASE ('held_suarez')
        phys_type = phys_HS94
-    CASE ('Lebonnois2012')
-       phys_type = phys_LB2012
-       CALL init_phys_venus       
     CASE ('phys_lmdz_generic')
        phys_type=phys_lmdz_generic
@@ -79 +75 @@
           phys_type = phys_DCMIP2016
           CALL init_physics_dcmip2016
+       CASE ('Lebonnois2012')
+          phys_type = phys_LB2012
+          CALL init_phys_venus       
        CASE DEFAULT
           IF(is_mpi_root) PRINT*, 'init_physics : Bad selector for variable physics <',&
@@ -129 +128 @@
   END SUBROUTINE add_du_phys
 
-  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
+  SUBROUTINE physics(it,f_phis, f_geopot, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
     USE physics_lmdz_generic_mod, ONLY : physics_lmdz_generic => physics
     USE physics_external_mod, ONLY : physics_external => physics
@@ -135 +134 @@
     USE physics_dcmip2016_mod, ONLY : write_physics_dcmip2016 => write_physics
     USE etat0_heldsz_mod
-    USE etat0_venus_mod, ONLY : phys_venus => physics
     INTEGER, INTENT(IN)   :: it
     TYPE(t_field),POINTER :: f_phis(:)
+    TYPE(t_field),POINTER :: f_geopot(:)
     TYPE(t_field),POINTER :: f_ps(:)
     TYPE(t_field),POINTER :: f_theta_rhodz(:)
@@ -161 +160 @@
        CASE (phys_external)
          CALL physics_external(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q)
-       CASE(phys_LB2012)
-          CALL phys_venus(f_ps,f_theta_rhodz,f_ue) 
        CASE DEFAULT
-          CALL physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
+          CALL physics_column(it, f_phis, f_geopot, f_ps, f_theta_rhodz, f_ue, f_q)
        END SELECT
 
@@ -197 +194 @@
   END SUBROUTINE write_physics_tendencies
     
-  SUBROUTINE physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q)
+  SUBROUTINE physics_column(it, f_phis, f_geopot, f_ps, f_theta_rhodz, f_ue, f_q)
     USE physics_dcmip_mod, ONLY : full_physics_dcmip => full_physics
     USE physics_dcmip2016_mod, ONLY : full_physics_dcmip2016 => full_physics
+    USE etat0_venus_mod, ONLY : full_physics_venus=>full_physics
     USE theta2theta_rhodz_mod
     USE mpipara
     USE checksum_mod
     TYPE(t_field),POINTER :: f_phis(:)
+    TYPE(t_field),POINTER :: f_geopot(:)
     TYPE(t_field),POINTER :: f_ps(:)
     TYPE(t_field),POINTER :: f_theta_rhodz(:)
@@ -209 +208 @@
     TYPE(t_field),POINTER :: f_q(:)
     REAL(rstd),POINTER :: phis(:)
+    REAL(rstd),POINTER :: geopot(:,:)
     REAL(rstd),POINTER :: ps(:)
     REAL(rstd),POINTER :: temp(:,:)
@@ -228 +228 @@
        CALL swap_geometry(ind)
        phis=f_phis(ind)
+       geopot=f_geopot(ind)
        ps=f_ps(ind)
        temp=f_temp(ind)
@@ -236 +237 @@
        ulon=f_ulon(ind)
        ulat=f_ulat(ind)
-       CALL pack_physics(pack_info(ind), phis, ps, temp, ue, q, p, pk, ulon, ulat)
+       CALL pack_physics(pack_info(ind), phis, geopot, ps, temp, ue, q, p, pk, ulon, ulat)
     END DO
 
@@ -244 +245 @@
     CASE (phys_DCMIP2016)
        IF (is_omp_level_master) CALL full_physics_dcmip2016
+    CASE(phys_LB2012)
+       IF (is_omp_level_master) CALL full_physics_venus
     CASE DEFAULT
        IF(is_master) PRINT *,'Internal error : illegal value of phys_type', phys_type
@@ -279 +282 @@
   END SUBROUTINE physics_column
 
-  SUBROUTINE pack_physics(info, phis, ps, temp, ue, q, p, pk, ulon, ulat )
+  SUBROUTINE pack_physics(info, phis, geopot, ps, temp, ue, q, p, pk, ulon, ulat )
     USE wind_mod
     USE pression_mod
@@ -286 +289 @@
     TYPE(t_pack_info) :: info
     REAL(rstd) :: phis(iim*jjm)
+    REAL(rstd) :: geopot(iim*jjm,llm+1)
     REAL(rstd) :: ps(iim*jjm)
     REAL(rstd) :: temp(iim*jjm,llm)
@@ -308 +312 @@
     IF (is_omp_level_master) THEN
       CALL pack_domain(info, phis, physics_inout%phis)
+      CALL pack_domain(info, geopot, physics_inout%geopot)
       CALL pack_domain(info, p, physics_inout%p)
       CALL pack_domain(info, pk, physics_inout%pk)