source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/phys/totalcloudfrac.f90 @ 224

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago
File size: 9.4 KB
Line 
1      subroutine totalcloudfrac(ngrid,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!-----------------------------------------------------------------------
22!   INCLUDE 'dimensions.h'
23!
24!   dimensions.h contient les dimensions du modele
25!   ndm est tel que iim=2**ndm
26!-----------------------------------------------------------------------
27
28      INTEGER iim,jjm,llm,ndm
29
30      PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
31
32!-----------------------------------------------------------------------
33!-----------------------------------------------------------------------
34!   INCLUDE 'dimphys.h'
35
36! ngridmx : number of horizontal grid points
37! note: the -1/jjm term will be 0; unless jj=1
38      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)   
39! nlayermx : number of atmospheric layers
40      integer, parameter :: nlayermx = llm 
41! nsoilmx : number of subterranean layers ! nsoilmx is now in comsoil_h
42      !integer, parameter :: nsoilmx = 4 ! for a test
43      !integer, parameter :: nsoilmx = 18 ! for z1=0.0002 m, depth = 18 m => mars case
44      !integer, parameter :: nsoilmx = 13 ! for z1=0.03 m, depth = 104.8 m => earth case
45!-----------------------------------------------------------------------
46
47!-----------------------------------------------------------------------
48! INCLUDE "comcstfi.h"
49
50      common/comcstfi/pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
51      common/comcstfi/avocado!,molrad,visc
52     
53      real pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
54      real avocado!,molrad,visc
55
56!
57! For Fortran 77/Fortran 90 compliance always use line continuation
58! symbols '&' in columns 73 and 6
59!
60! Group commons according to their type for minimal performance impact
61
62      COMMON/callkeys_l/callrad,corrk,calldifv,UseTurbDiff,calladj      &
63     &   , co2cond,callsoil                                             &
64     &   , season,diurnal,tlocked,rings_shadow,lwrite                   &
65     &   , callstats,calleofdump                                        &
66     &   , enertest                                                     &
67     &   , callgasvis,continuum,H2Ocont_simple,graybody                 &
68     &   , radfixed                                                     &
69     &   , meanOLR, specOLR                                             &
70     &   , kastprof                                                     &
71     &   , nosurf, oblate                                               &     
72     &   , newtonian, testradtimes                                      &
73     &   , check_cpp_match, force_cpp                                   &
74     &   , rayleigh                                                     &
75     &   , stelbbody                                                    &
76     &   , nearco2cond                                                  &
77     &   , tracer, mass_redistrib, varactive, varfixed                  &
78     &   , sedimentation,water,watercond,waterrain                      &
79     &   , aeroco2,aeroh2o,aeroh2so4,aeroback2lay                       &
80     &   , aerofixco2,aerofixh2o                                        &
81     &   , hydrology, sourceevol                                        &
82     &   , CLFvarying                                                   &
83     &   , strictboundcorrk                                             &                                       
84     &   , ok_slab_ocean                                                &
85     &   , ok_slab_sic                                                  &
86     &   , ok_slab_heat_transp                                         
87
88
89      COMMON/callkeys_i/iaervar,iddist,iradia,startype
90     
91      COMMON/callkeys_r/topdustref,Nmix_co2,dusttau,Fat1AU,stelTbb,     &
92     &                  Tstrat,tplanet,obs_tau_col_tropo,               &
93     &                  obs_tau_col_strato,pres_bottom_tropo,           &
94     &                  pres_top_tropo,pres_bottom_strato,              &
95     &                  pres_top_strato,size_tropo,size_strato,satval,  &
96     &                  CLFfixval,n2mixratio,co2supsat,pceil,albedosnow,&
97     &                  maxicethick,Tsaldiff,tau_relax,cloudlvl,        &
98     &                  icetstep,intheat,flatten,Rmean,J2,MassPlanet
99     
100      logical callrad,corrk,calldifv,UseTurbDiff                        &
101     &   , calladj,co2cond,callsoil                                     &
102     &   , season,diurnal,tlocked,rings_shadow,lwrite                   &
103     &   , callstats,calleofdump                                        &
104     &   , callgasvis,continuum,H2Ocont_simple,graybody                 &
105     &   , strictboundcorrk                                             
106
107      logical enertest
108      logical nonideal
109      logical meanOLR
110      logical specOLR
111      logical kastprof
112      logical newtonian
113      logical check_cpp_match
114      logical force_cpp
115      logical testradtimes
116      logical rayleigh
117      logical stelbbody
118      logical ozone
119      logical nearco2cond
120      logical tracer
121      logical mass_redistrib
122      logical varactive
123      logical varfixed
124      logical radfixed
125      logical sedimentation
126      logical water,watercond,waterrain
127      logical aeroco2,aeroh2o,aeroh2so4,aeroback2lay
128      logical aerofixco2,aerofixh2o
129      logical hydrology
130      logical sourceevol
131      logical CLFvarying
132      logical nosurf
133      logical oblate
134      logical ok_slab_ocean
135      logical ok_slab_sic
136      logical ok_slab_heat_transp
137
138      integer iddist
139      integer iaervar
140      integer iradia
141      integer startype
142
143      real topdustref
144      real Nmix_co2
145      real dusttau
146      real Fat1AU
147      real stelTbb
148      real Tstrat
149      real tplanet
150      real obs_tau_col_tropo
151      real obs_tau_col_strato
152      real pres_bottom_tropo
153      real pres_top_tropo
154      real pres_bottom_strato
155      real pres_top_strato
156      real size_tropo
157      real size_strato
158      real satval
159      real CLFfixval
160      real n2mixratio
161      real co2supsat
162      real pceil
163      real albedosnow
164      real maxicethick
165      real Tsaldiff
166      real tau_relax
167      real cloudlvl
168      real icetstep
169      real intheat
170      real flatten
171      real Rmean
172      real J2
173      real MassPlanet
174
175      integer,intent(in) :: ngrid        ! number of atmospheric columns
176      integer,intent(in) :: nq           ! number of tracers
177      real,intent(in) :: rneb(ngrid,nlayermx)    ! cloud fraction     
178      real,intent(out) :: totalrneb(ngrid)       ! total cloud fraction
179      real,intent(in) :: pplev(ngrid,nlayermx+1) ! inter-layer pressure (Pa)
180      real,intent(in) :: pq(ngrid,nlayermx,nq)   ! tracers (.../kg_of_air)
181      real,intent(in) :: tau(ngrid,nlayermx)
182
183      real, dimension(nlayermx+1) :: masse
184      integer, parameter          :: recovery=7
185      integer ltau_max
186      real massetot
187
188! hypothesis behind recovery. value:
189! 1 = random recovery
190! 2 = maximal recovery
191! 3 = minimal recovery
192! 4 = fixed recovery
193! 5 = recovery on the thicker layer
194!     Local variables
195      integer ig, l
196      real clear,tau_min
197      real, parameter ::  tau_c=0.1 !threshold of optical depth for the calculation of total cloud fraction
198      real rneb2(nlayermx)
199
200
201      do ig=1,ngrid
202         totalrneb(ig) = 0.
203
204         if (recovery.eq.1) then
205            clear = (1.-rneb(ig,1))
206            do l=2,nlayermx       
207               clear = clear*(1.-rneb(ig,l))
208            enddo
209            totalrneb(ig) = 1.-clear
210
211         elseif (recovery.eq.2) then
212            totalrneb(ig) = rneb(ig,1)
213            do l=2,14 !nlayermx       
214               totalrneb(ig) = max(rneb(ig,l),totalrneb(ig))
215            enddo
216           
217         elseif (recovery.eq.3) then
218            totalrneb(ig) = rneb(ig,1)
219            do l=2,nlayermx       
220               totalrneb(ig) = min(rneb(ig,l),totalrneb(ig))
221            enddo
222         
223         elseif (recovery.eq.4) then
224            totalrneb(ig) = CLFfixval
225
226         elseif (recovery.eq.5) then
227            totalrneb(ig) = rneb(ig,1)           
228            do l=1,nlayermx
229               masse(l)=pq(ig,l,igcm_h2o_ice)*(pplev(ig,l)-pplev(ig,l+1))
230            enddo
231            ltau_max=maxloc(masse,dim=1)
232            totalrneb(ig) = rneb(ig,ltau_max)
233
234         elseif (recovery.eq.6) then
235            totalrneb(ig) = 0.           
236            do l=1,nlayermx
237               masse(l)=pq(ig,l,igcm_h2o_ice)*(pplev(ig,l)-pplev(ig,l+1))
238               masse(l)=max(masse(l),0.)
239            enddo
240            massetot=sum(masse,dim=1)
241            do l=1,nlayermx
242               totalrneb(ig) = totalrneb(ig)+rneb(ig,l)*masse(l)/massetot
243            enddo
244
245         elseif (recovery.eq.7) then
246
247            rneb2(:)=rneb(ig,1:nlayermx)
248            tau_min=MIN(tau_c,MAXVAL(tau(ig,1:nlayermx))/2.)
249            do l=1,nlayermx
250               if(tau(ig,l)<tau_min) rneb2(l)=0.       
251            enddo
252            totalrneb(ig)=maxval(rneb2(1:nlayermx))
253
254         endif                  ! (recovery=)   
255
256         totalrneb(ig) = min(1.,totalrneb(ig))
257         totalrneb(ig) = max(0.,totalrneb(ig))
258         
259      enddo                     ! (ig=)
260     
261     
262    end subroutine totalcloudfrac
Note: See TracBrowser for help on using the repository browser.