Changeset 2897 for LMDZ5/trunk/libf/phylmd/orografi_strato.F90

Timestamp:

May 31, 2017, 12:34:09 AM (7 years ago)

Author:

fhourdin

Message:

Introduction d'une possible prise en compte de génération de TKE
par les ondes de relief.
Etienne Vignon et FH

File:

• LMDZ5/trunk/libf/phylmd/orografi_strato.F90 (modified) (12 diffs)

LMDZ5/trunk/libf/phylmd/orografi_strato.F90

@@ -1 @@
-SUBROUTINE drag_noro_strato(nlon, nlev, dtime, paprs, pplay, pmea, pstd, &
+SUBROUTINE drag_noro_strato(partdrag, nlon, nlev, dtime, paprs, pplay, pmea, pstd, &
     psig, pgam, pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, &
     pustr, pvstr, d_t, d_u, d_v)
@@ -15 +15 @@
   ! Explicit Arguments:
   ! ==================
+  ! partdrag-input-I-control which part of the drag we consider (total part or GW part)
   ! nlon----input-I-Total number of horizontal points that get into physics
   ! nlev----input-I-Number of vertical levels
@@ -66 +67 @@
   ! ARGUMENTS
 
-  INTEGER nlon, nlev
+  INTEGER partdrag,nlon, nlev
   REAL dtime
   REAL paprs(nlon, nlev+1)
@@ -134 +135 @@
   ! CALL SSO DRAG ROUTINES
 
-  CALL orodrag_strato(klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, &
+  CALL orodrag_strato(partdrag,klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, &
     zgeom, pt, pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, &
     pvlow, pdudt, pdvdt, pdtdt)
@@ -153 +154 @@
 END SUBROUTINE drag_noro_strato
 
-SUBROUTINE orodrag_strato(nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, &
+SUBROUTINE orodrag_strato(partdrag,nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, &
     papm1, pgeom1, ptm1, pum1, pvm1, pmea, pstd, psig, pgam, pthe, ppic, pval &
   ! outputs
@@ -182 +183 @@
   ! --------------------
   ! ==== inputs ===
+  ! partdrag-input-I-control which part of the drag we consider (total part or GW part)
   ! nlon----input-I-Total number of horizontal points that get into physics
   ! nlev----input-I-Number of vertical levels
@@ -201 +203 @@
   ! pval----input-R-SSO Valleys elevation (m)
 
-  INTEGER nlon, nlev, kgwd
+  INTEGER  nlon, nlev, kgwd
   REAL ptsphy
 
@@ -239 +241 @@
   include "YOMCST.h"
   include "YOEGWD.h"
+
   ! -----------------------------------------------------------------------
 
@@ -244 +247 @@
   ! ---------
 
-
+  INTEGER partdrag
   REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(nlon), &
     pvlow(nlon)
@@ -269 +272 @@
 
   INTEGER jl, jk, ji
-  REAL ztmst, zdelp, ztemp, zforc, ztend, rover
+  REAL ztmst, zdelp, ztemp, zforc, ztend, rover, facpart
   REAL zb, zc, zconb, zabsv, zzd1, ratio, zbet, zust, zvst, zdis
 
@@ -393 +396 @@
         ! -----------------
 
+        IF (partdrag .GE. 2) THEN
+        facpart=0.
+        ELSE
+        facpart=gkwake
+        ENDIF
+
+
         IF (jk>ikenvh(ji)) THEN
           zb = 1.0 - 0.18*pgam(ji) - 0.04*pgam(ji)**2
           zc = 0.48*pgam(ji) + 0.3*pgam(ji)**2
-          zconb = 2.*ztmst*gkwake*psig(ji)/(4.*pstd(ji))
+          zconb = 2.*ztmst*facpart*psig(ji)/(4.*pstd(ji))
           zabsv = sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2.
           zzd1 = zb*cos(zpsi(ji,jk))**2 + zc*sin(zpsi(ji,jk))**2
@@ -1894 +1904 @@
   RETURN
 END SUBROUTINE sugwd_strato
-