source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/totalcloudfrac.F90 @ 227

Last change on this file since 227 was 227, checked in by milmd, 10 years ago

Last LMDZ version (1315) with OpenMP directives and other stuff

File size: 3.5 KB
Line 
1      subroutine totalcloudfrac(ngrid,nlayer,nq,rneb,totalrneb,pplev,pq,tau)
2
3      use watercommon_h
4      use comdiurn_h
5      USE comgeomfi_h
6      USE tracer_h, only: igcm_h2o_ice
7      implicit none
8
9!==================================================================
10!     
11!     Purpose
12!     -------
13!     Calculates the total cloud fraction
14!     
15!     Authors
16!     -------
17!     Adapted from the LMDTERRE code by B Charnay (2010)
18!     
19!==================================================================
20
21!#include "dimensions.h"
22!#include "dimphys.h"
23#include "comcstfi.h"
24#include "callkeys.h"
25
26      integer,intent(in) :: ngrid        ! number of atmospheric columns
27      integer,intent(in) :: nlayer       ! number of atmospheric layers
28      integer,intent(in) :: nq           ! number of tracers
29      real,intent(in) :: rneb(ngrid,nlayer)    ! cloud fraction     
30      real,intent(out) :: totalrneb(ngrid)       ! total cloud fraction
31      real,intent(in) :: pplev(ngrid,nlayer+1) ! inter-layer pressure (Pa)
32      real,intent(in) :: pq(ngrid,nlayer,nq)   ! tracers (.../kg_of_air)
33      real,intent(in) :: tau(ngrid,nlayer)
34
35      real, dimension(nlayer+1) :: masse
36      integer, parameter          :: recovery=7
37      integer ltau_max
38      real massetot
39
40! hypothesis behind recovery. value:
41! 1 = random recovery
42! 2 = maximal recovery
43! 3 = minimal recovery
44! 4 = fixed recovery
45! 5 = recovery on the thicker layer
46!     Local variables
47      integer ig, l
48      real clear,tau_min
49      real, parameter ::  tau_c=0.1 !threshold of optical depth for the calculation of total cloud fraction
50      real rneb2(nlayer)
51
52
53      do ig=1,ngrid
54         totalrneb(ig) = 0.
55
56         if (recovery.eq.1) then
57            clear = (1.-rneb(ig,1))
58            do l=2,nlayer     
59               clear = clear*(1.-rneb(ig,l))
60            enddo
61            totalrneb(ig) = 1.-clear
62
63         elseif (recovery.eq.2) then
64            totalrneb(ig) = rneb(ig,1)
65            do l=2,14 !nlayer   
66               totalrneb(ig) = max(rneb(ig,l),totalrneb(ig))
67            enddo
68           
69         elseif (recovery.eq.3) then
70            totalrneb(ig) = rneb(ig,1)
71            do l=2,nlayer   
72               totalrneb(ig) = min(rneb(ig,l),totalrneb(ig))
73            enddo
74         
75         elseif (recovery.eq.4) then
76            totalrneb(ig) = CLFfixval
77
78         elseif (recovery.eq.5) then
79            totalrneb(ig) = rneb(ig,1)           
80            do l=1,nlayer
81               masse(l)=pq(ig,l,igcm_h2o_ice)*(pplev(ig,l)-pplev(ig,l+1))
82            enddo
83            ltau_max=maxloc(masse,dim=1)
84            totalrneb(ig) = rneb(ig,ltau_max)
85
86         elseif (recovery.eq.6) then
87            totalrneb(ig) = 0.           
88            do l=1,nlayer
89               masse(l)=pq(ig,l,igcm_h2o_ice)*(pplev(ig,l)-pplev(ig,l+1))
90               masse(l)=max(masse(l),0.)
91            enddo
92            massetot=sum(masse,dim=1)
93            do l=1,nlayer
94               totalrneb(ig) = totalrneb(ig)+rneb(ig,l)*masse(l)/massetot
95            enddo
96
97         elseif (recovery.eq.7) then
98
99            rneb2(:)=rneb(ig,1:nlayer)
100            tau_min=MIN(tau_c,MAXVAL(tau(ig,1:nlayer))/2.)
101            do l=1,nlayer
102               if(tau(ig,l)<tau_min) rneb2(l)=0.       
103            enddo
104            totalrneb(ig)=maxval(rneb2(1:nlayer))
105
106         endif                  ! (recovery=)   
107
108         totalrneb(ig) = min(1.,totalrneb(ig))
109         totalrneb(ig) = max(0.,totalrneb(ig))
110         
111      enddo                     ! (ig=)
112     
113     
114    end subroutine totalcloudfrac
Note: See TracBrowser for help on using the repository browser.