subroutine totalcloudfrac(ngrid,nq,rneb,totalrneb,pplev,pq,tau) use watercommon_h use comdiurn_h USE comgeomfi_h USE tracer_h, only: igcm_h2o_ice implicit none !================================================================== ! ! Purpose ! ------- ! Calculates the total cloud fraction ! ! Authors ! ------- ! Adapted from the LMDTERRE code by B Charnay (2010) ! !================================================================== !----------------------------------------------------------------------- ! INCLUDE 'dimensions.h' ! ! dimensions.h contient les dimensions du modele ! ndm est tel que iim=2**ndm !----------------------------------------------------------------------- INTEGER iim,jjm,llm,ndm PARAMETER (iim= 128,jjm=96,llm=64,ndm=1) !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! INCLUDE 'dimphys.h' ! ngridmx : number of horizontal grid points ! note: the -1/jjm term will be 0; unless jj=1 integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) ! nlayermx : number of atmospheric layers integer, parameter :: nlayermx = llm ! nsoilmx : number of subterranean layers ! nsoilmx is now in comsoil_h !integer, parameter :: nsoilmx = 4 ! for a test !integer, parameter :: nsoilmx = 18 ! for z1=0.0002 m, depth = 18 m => mars case !integer, parameter :: nsoilmx = 13 ! for z1=0.03 m, depth = 104.8 m => earth case !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! INCLUDE "comcstfi.h" common/comcstfi/pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg common/comcstfi/avocado!,molrad,visc real pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg real avocado!,molrad,visc ! ! For Fortran 77/Fortran 90 compliance always use line continuation ! symbols '&' in columns 73 and 6 ! ! Group commons according to their type for minimal performance impact COMMON/callkeys_l/callrad,corrk,calldifv,UseTurbDiff,calladj & & , co2cond,callsoil & & , season,diurnal,tlocked,rings_shadow,lwrite & & , callstats,calleofdump & & , enertest & & , callgasvis,continuum,H2Ocont_simple,graybody & & , radfixed & & , meanOLR, specOLR & & , kastprof & & , nosurf, oblate & & , newtonian, testradtimes & & , check_cpp_match, force_cpp & & , rayleigh & & , stelbbody & & , nearco2cond & & , tracer, mass_redistrib, varactive, varfixed & & , sedimentation,water,watercond,waterrain & & , aeroco2,aeroh2o,aeroh2so4,aeroback2lay & & , aerofixco2,aerofixh2o & & , hydrology, sourceevol & & , CLFvarying & & , strictboundcorrk & & , ok_slab_ocean & & , ok_slab_sic & & , ok_slab_heat_transp COMMON/callkeys_i/iaervar,iddist,iradia,startype COMMON/callkeys_r/topdustref,Nmix_co2,dusttau,Fat1AU,stelTbb, & & Tstrat,tplanet,obs_tau_col_tropo, & & obs_tau_col_strato,pres_bottom_tropo, & & pres_top_tropo,pres_bottom_strato, & & pres_top_strato,size_tropo,size_strato,satval, & & CLFfixval,n2mixratio,co2supsat,pceil,albedosnow,& & maxicethick,Tsaldiff,tau_relax,cloudlvl, & & icetstep,intheat,flatten,Rmean,J2,MassPlanet logical callrad,corrk,calldifv,UseTurbDiff & & , calladj,co2cond,callsoil & & , season,diurnal,tlocked,rings_shadow,lwrite & & , callstats,calleofdump & & , callgasvis,continuum,H2Ocont_simple,graybody & & , strictboundcorrk logical enertest logical nonideal logical meanOLR logical specOLR logical kastprof logical newtonian logical check_cpp_match logical force_cpp logical testradtimes logical rayleigh logical stelbbody logical ozone logical nearco2cond logical tracer logical mass_redistrib logical varactive logical varfixed logical radfixed logical sedimentation logical water,watercond,waterrain logical aeroco2,aeroh2o,aeroh2so4,aeroback2lay logical aerofixco2,aerofixh2o logical hydrology logical sourceevol logical CLFvarying logical nosurf logical oblate logical ok_slab_ocean logical ok_slab_sic logical ok_slab_heat_transp integer iddist integer iaervar integer iradia integer startype real topdustref real Nmix_co2 real dusttau real Fat1AU real stelTbb real Tstrat real tplanet real obs_tau_col_tropo real obs_tau_col_strato real pres_bottom_tropo real pres_top_tropo real pres_bottom_strato real pres_top_strato real size_tropo real size_strato real satval real CLFfixval real n2mixratio real co2supsat real pceil real albedosnow real maxicethick real Tsaldiff real tau_relax real cloudlvl real icetstep real intheat real flatten real Rmean real J2 real MassPlanet integer,intent(in) :: ngrid ! number of atmospheric columns integer,intent(in) :: nq ! number of tracers real,intent(in) :: rneb(ngrid,nlayermx) ! cloud fraction real,intent(out) :: totalrneb(ngrid) ! total cloud fraction real,intent(in) :: pplev(ngrid,nlayermx+1) ! inter-layer pressure (Pa) real,intent(in) :: pq(ngrid,nlayermx,nq) ! tracers (.../kg_of_air) real,intent(in) :: tau(ngrid,nlayermx) real, dimension(nlayermx+1) :: masse integer, parameter :: recovery=7 integer ltau_max real massetot ! hypothesis behind recovery. value: ! 1 = random recovery ! 2 = maximal recovery ! 3 = minimal recovery ! 4 = fixed recovery ! 5 = recovery on the thicker layer ! Local variables integer ig, l real clear,tau_min real, parameter :: tau_c=0.1 !threshold of optical depth for the calculation of total cloud fraction real rneb2(nlayermx) do ig=1,ngrid totalrneb(ig) = 0. if (recovery.eq.1) then clear = (1.-rneb(ig,1)) do l=2,nlayermx clear = clear*(1.-rneb(ig,l)) enddo totalrneb(ig) = 1.-clear elseif (recovery.eq.2) then totalrneb(ig) = rneb(ig,1) do l=2,14 !nlayermx totalrneb(ig) = max(rneb(ig,l),totalrneb(ig)) enddo elseif (recovery.eq.3) then totalrneb(ig) = rneb(ig,1) do l=2,nlayermx totalrneb(ig) = min(rneb(ig,l),totalrneb(ig)) enddo elseif (recovery.eq.4) then totalrneb(ig) = CLFfixval elseif (recovery.eq.5) then totalrneb(ig) = rneb(ig,1) do l=1,nlayermx masse(l)=pq(ig,l,igcm_h2o_ice)*(pplev(ig,l)-pplev(ig,l+1)) enddo ltau_max=maxloc(masse,dim=1) totalrneb(ig) = rneb(ig,ltau_max) elseif (recovery.eq.6) then totalrneb(ig) = 0. do l=1,nlayermx masse(l)=pq(ig,l,igcm_h2o_ice)*(pplev(ig,l)-pplev(ig,l+1)) masse(l)=max(masse(l),0.) enddo massetot=sum(masse,dim=1) do l=1,nlayermx totalrneb(ig) = totalrneb(ig)+rneb(ig,l)*masse(l)/massetot enddo elseif (recovery.eq.7) then rneb2(:)=rneb(ig,1:nlayermx) tau_min=MIN(tau_c,MAXVAL(tau(ig,1:nlayermx))/2.) do l=1,nlayermx if(tau(ig,l)