Changeset 4013 for LMDZ6/branches/Ocean_skin/libf/phylmd/calcratqs.F90

Timestamp:

Nov 19, 2021, 4:58:59 PM (3 years ago)

Author:

lguez

Message:

Sync latest trunk changes to Ocean_skin

Location:

LMDZ6/branches/Ocean_skin

Files:

• . (modified) (1 prop)
• libf/phylmd/calcratqs.F90 (modified) (5 diffs)

LMDZ6/branches/Ocean_skin/libf/phylmd/calcratqs.F90

@@ -2 +2 @@
            iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
            ratqsbas,ratqshaut,ratqsp0,ratqsdp, &
-           tau_ratqs,fact_cldcon,   &
-           ptconv,ptconvth,clwcon0th, rnebcon0th,      &
-           paprs,pplay,q_seri,zqsat,fm_therm,          &
-           ratqs,ratqsc)
+           tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
+           ptconv,ptconvth,clwcon0th, rnebcon0th,       &
+           paprs,pplay,t_seri,q_seri,                   &
+           qtc_cv, sigt_cv, zqsat,             &
+           tke,tke_dissip,lmix,wprime, &
+           t2m,q2m,fm_therm, &
+           ratqs,ratqsc,ratqs_inter)
+
+
+USE indice_sol_mod
+USE phys_state_var_mod, ONLY: pctsrf
+USE calcratqs_multi_mod, ONLY: calcratqs_inter, calcratqs_oro, calcratqs_hetero, calcratqs_tke
 
 implicit none
@@ -23 +31 @@
 real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
 real,intent(in) :: ratqsp0, ratqsdp
-real, dimension(klon,klev+1),intent(in) :: paprs
-real, dimension(klon,klev),intent(in) :: pplay,q_seri,zqsat,fm_therm
+real, dimension(klon,klev+1),intent(in) :: paprs,tke,tke_dissip,lmix,wprime
+real, dimension(klon,klev),intent(in) :: pplay,t_seri,q_seri,zqsat,fm_therm, qtc_cv, sigt_cv
 logical, dimension(klon,klev),intent(in) :: ptconv
 real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th
-
+real, dimension(klon,klev),intent(in) :: wake_deltaq,wake_s
+real, dimension(klon,nbsrf),intent(in) :: t2m,q2m
 ! Output
-real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc
+real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc,ratqs_inter
+
 logical, dimension(klon,klev),intent(inout) :: ptconvth
 
@@ -36 +46 @@
 real, dimension(klon,klev) :: ratqss
 real facteur,zfratqs1,zfratqs2
+real, dimension(klon,klev) :: ratqs_hetero,ratqs_oro,ratqs_tke
+
 
 !-------------------------------------------------------------------------
@@ -124 +136 @@
          enddo
 
-      else if (iflag_ratqs==4) then
+      else if (iflag_ratqs==4) then 
          do k=1,klev
            ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
@@ -131 +143 @@
          enddo
 
+       else if (iflag_ratqs .GT. 9) then
+ 
+       ! interactive ratqs calculations that depend on cold pools, orography, surface heterogeneity and small-scale turbulence
+       ! This should help getting a more realistic ratqs in the low and mid troposphere
+       ! We however need a "background" ratqs to account for subgrid distribution of qt (or qt/qs)
+       ! in the high troposphere
+       
+       ! background ratqs and initialisations
+          do k=1,klev
+             do i=1,klon
+              ratqss(i,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
+              *( tanh( (ratqsp0-pplay(i,k))/ratqsdp) + 1.)
+              ratqss(i,k)=max(ratqss(i,k),0.0)
+
+              ratqs_hetero(i,k)=0.
+              ratqs_oro(i,k)=0.
+              ratqs_tke(i,k)=0.
+              ratqs_inter(i,k)=0
+             enddo
+          enddo
+      
+          if (iflag_ratqs .EQ. 10) then 
+             ! interactive ratqs in presence of cold pools     
+             call calcratqs_inter(klon,klev,iflag_ratqs,pdtphys,ratqsbas,wake_deltaq,wake_s,q_seri,qtc_cv, sigt_cv,ratqs_inter)
+             do k=1,klev
+                do i=1,klon
+                    ratqs_inter(i,k)=ratqs_inter(i,k)-0.5*ratqs_inter(i,k)*(tanh((ratqsp0-pplay(i,k))/ratqsdp)+1.)
+                enddo
+             enddo
+             ratqss=ratqss+ratqs_inter
+          else if (iflag_ratqs .EQ. 11) then
+            ! interactive ratqs with several sources
+            call calcratqs_inter(klon,klev,iflag_ratqs,pdtphys,ratqsbas,wake_deltaq,wake_s,q_seri,qtc_cv, sigt_cv,ratqs_inter)
+             ratqss=ratqss+ratqs_inter
+          else if (iflag_ratqs .EQ. 12) then
+             ! contribution of surface heterogeneities to ratqs
+             call calcratqs_hetero(klon,klev,t2m,q2m,t_seri,q_seri,pplay,paprs,ratqs_hetero)
+             ratqss=ratqss+ratqs_hetero
+          else if (iflag_ratqs .EQ. 13) then
+             ! contribution of ubgrid orography to ratqs
+             call calcratqs_oro(klon,klev,zqsat,t_seri,pplay,paprs,ratqs_oro)
+             ratqss=ratqss+ratqs_oro
+          else if (iflag_ratqs .EQ. 14) then
+             ! effect of subgrid-scale TKE on ratqs (in development)
+             call calcratqs_tke(klon,klev,pdtphys,t_seri,q_seri,zqsat,pplay,paprs,tke,tke_dissip,lmix,wprime,ratqs_tke)     
+             ratqss=ratqss+ratqs_tke
+          endif
+          
+      
       endif
-
-