<p><b>laura@ucar.edu</b> 2011-10-17 11:54:10 -0600 (Mon, 17 Oct 2011)</p><p>added subroutine calc_cldfraction to calculate the cloud fraction as a function of the relative humidity<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_driver_cloudiness.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_cloudiness.F        2011-10-17 17:49:39 UTC (rev 1092)
+++ branches/atmos_physics/src/core_physics/module_driver_cloudiness.F        2011-10-17 17:54:10 UTC (rev 1093)
@@ -2,6 +2,7 @@
  module module_driver_cloudiness
  use grid_types
 
+ use module_physics_constants, only: ep_2
  use module_physics_vars
  
  implicit none
@@ -76,16 +77,36 @@
  type(diag_physics_type),intent(inout):: diag_physics
 
 !---------------------------------------------------------------------------------------------
+ write(0,*)
+ write(0,*) '--- enter subroutine driver_cloudiness:'
 
 !copy all MPAS arrays to rectangular grid:
  call cloudiness_from_MPAS(diag_physics)
 
-!calculate the incidence of clouds:
- call calc_cldincidence(cldfrac_p,qc_p,qi_p,f_qc,f_qi)
+ cld_fraction_select: select case (trim(radt_cld_scheme))
+    case(&quot;cld_incidence&quot;)
 
+      !calculate the incidence of clouds:
+      write(0,*) '--- enter subroutine calc_cldincidence:'
+      call calc_cldincidence(cldfrac_p,qc_p,qi_p,f_qc,f_qi)
+      write(0,*) '--- exit subroutine calc_cldincidence'
+
+    case(&quot;cld_fraction&quot;)
+
+      !calculate the cloud fraction based on the relative humidity:
+      write(0,*) '--- enter subroutine calc_cldfraction:'
+      call calc_cldfraction(cldfrac_p,t_p,pres_p,qv_p,qc_p,qi_p,qs_p)
+      write(0,*) '--- exit subroutine calc_cldfraction'
+
+    case default
+
+ end select cld_fraction_select
+
 !copy all arrays back to MPAS geodesic grid:
  call cloudiness_to_MPAS(diag_physics)
 
+ write(0,*) '--- exit subroutine driver_cloudiness'
+
  end subroutine driver_cloudiness
 
 !=============================================================================================
@@ -133,5 +154,95 @@
  end subroutine calc_cldincidence
 
 !=============================================================================================
+ subroutine calc_cldfraction(cldfrac,t_p,pres_p,qv,qc,qi,qs)
+!=============================================================================================
+
+!input arguments:
+ real(kind=RKIND),intent(in),dimension(ims:ime,kms:kme,jms:jme):: qv,qc,qi,qs
+ real(kind=RKIND),intent(in),dimension(ims:ime,kms:kme,jms:jme):: t_p,pres_p
+
+!output arguments:
+ real(kind=RKIND),intent(out),dimension(ims:ime,kms:kme,jms:jme):: cldfrac
+
+!local variables:
+ real(kind=RKIND),parameter:: alpha0  = 100.
+ real(kind=RKIND),parameter:: gamma   = 0.49
+ real(kind=RKIND),parameter:: qcldmin = 1.e-12
+ real(kind=RKIND),parameter:: pexp    = 0.25
+ real(kind=RKIND),parameter:: rhgrid  = 1.0
+
+ real(kind=RKIND),parameter:: svp1  = 0.61078
+ real(kind=RKIND),parameter:: svp2  = 17.2693882
+ real(kind=RKIND),parameter:: svpi2 = 21.8745584
+ real(kind=RKIND),parameter:: svp3  = 35.86
+ real(kind=RKIND),parameter:: svpi3 = 7.66
+ real(kind=RKIND),parameter:: svpt0 = 273.15
+
+ real(kind=RKIND):: esi,esw,qvsi,qvsw
+ real(kind=RKIND):: arg,denom,qcld,qvs,rhum,subsat,weight
+
+!---------------------------------------------------------------------------------------------
+
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+    cldfrac(i,k,j) = 0.
+ enddo
+ enddo
+ enddo
+ 
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+
+!... calculation of the saturation mixing ratios over water and over ice (Murray, 1966):
+    esw = 1000. * svp1 * exp(svp2 * (t_p(i,k,j) - svpt0) / (t_p(i,k,j) - svp3))
+    esi = 1000. * svp1 * exp(svpi2 * (t_p(i,k,j) - svpt0) / (t_p(i,k,j) - svpi3))
+
+    qvsw = ep_2 * esw / (pres_p(i,k,j) - esw)
+    qvsi = ep_2 * esi / (pres_p(i,k,j) - esi)
+
+    qcld = qc(i,k,j) + qi(i,k,j) + qs(i,k,j)
+    if(qcld .lt. qcldmin) then
+       weight = 0.
+    else
+       weight = (qi(i,k,j) + qs(i,k,j)) / qcld
+    endif
+
+    qvs = (1-weight) * qvsw + weight * qvsi
+    rhum = qv(i,k,j) / qvs
+
+    if(qcld .lt. qcldmin) then
+
+       !assume that the cloud fraction is equal to 0. when the cloudy mixing ratio equals 0.
+       cldfrac(i,k,j) = 0.
+
+    elseif(rhum .ge. rhgrid) then
+       !assume that the cloud fraction is equal to 1. when the relative humidity equal 100%.
+       cldfrac(i,k,j) = 1.
+
+    else
+       !computation of the cloud fraction:
+       subsat = max(1.e-10,rhgrid*qvs-qv(i,k,j))
+       denom  = subsat**gamma
+       arg    = max(-6.9,-alpha0*qcld/denom) ! exp(-6.9) = 0.001
+
+       rhum = max(1.e-10,rhum)
+       cldfrac(i,k,j) = (rhum/rhgrid)**pexp*(1.-exp(arg))
+       if(cldfrac(i,k,j) .lt. 0.01) cldfrac(i,k,j) = 0.
+
+    endif
+
+!   if(qcld .ge. qcldmin) write(0,101) i,k,qcld,rhum,cldfrac(i,k,j) 
+
+ enddo
+ enddo
+ enddo
+
+ 101 format(i8,1x,i3,3(1x,e15.8))
+
+ end subroutine calc_cldfraction
+
+!=============================================================================================
  end module module_driver_cloudiness
 !=============================================================================================

</font>
</pre>