subroutine simpleclouds(ngrid,nlay,ptimestep, & pplev,pplay,pzlev,pzlay,pt,pdt, & pq,pdq,pdqcloud,pdqscloud,pdtcloud, & nq,tau,rice,nuice,rsedcloud) implicit none c------------------------------------------------------------------ c This routine is used to form clouds when a parcel of the GCM is c saturated. It is a simplified scheme, and there is almost no c microphysics involved. When the air is saturated, water-ice c clouds form on a fraction of the dust particles, specified by c the constant called "ccn_factor". There is no supersaturation, c and no nucleation rates computed. A more accurate scheme can c be found in the routine called "improvedclouds.F". c Modif de zq si saturation dans l'atmosphere c si zq(ig,l)> zqsat(ig,l) -> zq(ig,l)=zqsat(ig,l) c Le test est effectue de bas en haut. L'eau condensee c (si saturation) est remise dans la couche en dessous. c L'eau condensee dans la couche du bas est deposee a la surface c Authors: Franck Montmessin (water ice scheme) c Francois Forget (changed nuclei density & outputs) c Ehouarn Millour (sept.2008, tracers are now handled c by name and not fixed index) c J.-B. Madeleine (developed a single routine called c simpleclouds.F, and corrected calculations c of the typical CCN profile, Oct. 2011) c------------------------------------------------------------------ #include "dimensions.h" #include "dimphys.h" #include "comcstfi.h" #include "callkeys.h" #include "tracer.h" #include "comgeomfi.h" #include "dimradmars.h" c------------------------------------------------------------------ c Arguments: c --------- c Inputs: INTEGER ngrid,nlay integer nq ! nombre de traceurs REAL ptimestep ! pas de temps physique (s) REAL pplev(ngrid,nlay+1) ! pression aux inter-couches (Pa) REAL pplay(ngrid,nlay) ! pression au milieu des couches (Pa) REAL pzlev(ngrid,nlay+1) ! altitude at layer boundaries REAL pzlay(ngrid,nlay) ! altitude at the middle of the layers REAL pt(ngrid,nlay) ! temperature at the middle of the ! layers (K) REAL pdt(ngrid,nlay) ! tendance temperature des autres ! param. real pq(ngrid,nlay,nq) ! traceur (kg/kg) real pdq(ngrid,nlay,nq) ! tendance avant condensation ! (kg/kg.s-1) REAL tau(ngridmx,naerkind) ! Column dust optical depth at each point c Output: REAL rice(ngrid,nlay) ! Ice mass mean radius (m) ! (r_c in montmessin_2004) REAL nuice(ngrid,nlay) ! Estimated effective variance ! of the size distribution real rsedcloud(ngridmx,nlayermx) ! Cloud sedimentation radius real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation ! H2O(kg/kg.s-1) real pdqscloud(ngrid,nq) ! flux en surface (kg.m-2.s-1) REAL pdtcloud(ngrid,nlay) ! tendance temperature due ! a la chaleur latente c------------------------------------------------------------------ c Local variables: LOGICAL firstcall DATA firstcall/.true./ SAVE firstcall REAL CBRT EXTERNAL CBRT INTEGER ig,l REAL zq(ngridmx,nlayermx,nqmx) ! local value of tracers REAL zq0(ngridmx,nlayermx,nqmx) ! local initial value of tracers REAL zt(ngridmx,nlayermx) ! local value of temperature REAL zqsat(ngridmx,nlayermx) ! saturation REAL*8 dzq ! masse de glace echangee (kg/kg) REAL lw !Latent heat of sublimation (J.kg-1) REAL,PARAMETER :: To=273.15 ! reference temperature, T=273.15 K real rdusttyp(ngridmx,nlayermx) ! Typical dust geom. mean radius (m) REAL ccntyp(ngridmx,nlayermx) ! Typical dust number density (#/kg) c CCN reduction factor c REAL, PARAMETER :: ccn_factor = 4.5 !! comme TESTS_JB // 1. avant REAL Mcon_out(ngridmx,nlayermx) ! mass to be condensed (not dMice !!) c----------------------------------------------------------------------- c 1. initialisation c ----------------- c On "update" la valeur de q(nqmx) (water vapor) et temperature. c On effectue qqes calculs preliminaires sur les couches : do l=1,nlay do ig=1,ngrid zq(ig,l,igcm_h2o_vap)= & pq(ig,l,igcm_h2o_vap)+pdq(ig,l,igcm_h2o_vap)*ptimestep zq(ig,l,igcm_h2o_vap)=max(zq(ig,l,igcm_h2o_vap),1.E-30) ! FF 12/2004 zq0(ig,l,igcm_h2o_vap)=zq(ig,l,igcm_h2o_vap) zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep zq(ig,l,igcm_h2o_ice)= & pq(ig,l,igcm_h2o_ice)+pdq(ig,l,igcm_h2o_ice)*ptimestep zq(ig,l,igcm_h2o_ice)=max(zq(ig,l,igcm_h2o_ice),0.) ! FF 12/2004 zq0(ig,l,igcm_h2o_ice)=zq(ig,l,igcm_h2o_ice) enddo enddo do l=1,nlay do ig=1,ngrid c Typical dust radius profile: rdusttyp(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9) c Typical CCN profile: c Corrected equation, following Montmessin et al. 2004 c (N0=2e6 m-3 has been converted into N0=1.3e8 kg-1, otherwise c the equation for rice is not homogeneous...) ccntyp(ig,l)= & 1.3e+8*max(tau(ig,1),0.001)/0.1*exp(-pzlay(ig,l)/10000.) c The previously used profile was not correct: c ccntyp(ig,l)=( epaisseur(ig,l)/masse(ig,l) ) * c & 2.e+6/0.1*max(tau(ig,1),0.001)*exp(-pzlay(ig,l)/10000.) c Reduce number of nuclei ! TEMPORAIRE : decrease the number of CCNs FF 04/200 ! reduction facteur 3 ! ccntyp(ig,l) = ccntyp(ig,l) / 27. ! reduction facteur 2 ! ccntyp(ig,l) = ccntyp(ig,l) / 8. c ----------------------------------------------------------------- ccntyp(ig,l) = ccntyp(ig,l) / ccn_factor enddo ! of do ig=1,ngrid enddo ! of dol=1,nlay pdqscloud(1:ngrid,1:nq)=0 pdqcloud(1:ngrid,1:nlay,1:nq)=0 pdtcloud(1:ngrid,1:nlay)=0 c ---------------------------------------------- c c c Rapport de melange a saturation dans la couche l : ------- c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ call watersat(ngridmx*nlayermx,zt,pplay,zqsat) c taux de condensation (kg/kg/s-1) dans les differentes couches c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ do l=1,nlay do ig=1,ngrid if (zq(ig,l,igcm_h2o_vap).ge.zqsat(ig,l))then ! Condensation dzq=zq(ig,l,igcm_h2o_vap)-zqsat(ig,l) elseif(zq(ig,l,igcm_h2o_vap).lt.zqsat(ig,l))then ! Sublimation dzq=-min(zqsat(ig,l)-zq(ig,l,igcm_h2o_vap), & zq(ig,l,igcm_h2o_ice)) endif c Water Mass change c ~~~~~~~~~~~~~~~~~ zq(ig,l,igcm_h2o_ice)=zq(ig,l,igcm_h2o_ice)+dzq zq(ig,l,igcm_h2o_vap)=zq(ig,l,igcm_h2o_vap)-dzq Mcon_out(ig,l) = dzq c Calcul du rayon moyen des particules de glace. c Hypothese : Dans une couche, la glace presente se c repartit uniformement autour du nbre de poussieres c dont le rayon moyen est prescrit par rdusttyp. c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ rice(ig,l)=max( CBRT ( (zq(ig,l,igcm_h2o_ice)/rho_ice & +ccntyp(ig,l)*(4./3.)*pi*rdusttyp(ig,l)**3.) & /(ccntyp(ig,l)*4./3.*pi) ), rdusttyp(ig,l)) c Effective variance of the size distribution nuice(ig,l)=nuice_ref c Sedimentation radius: c ~~~~~~~~~~~~~~~~~~~~ rsedcloud(ig,l)=max( rice(ig,l)*(1.+nuice_sed)**3., & rdusttyp(ig,l) ) rsedcloud(ig,l)=min(rsedcloud(ig,l),1.e-4) enddo ! of do ig=1,ngrid enddo ! of do l=1,nlay c Tendance finale c ~~~~~~~~~~~~~~~ do l=1, nlay do ig=1,ngridmx pdqcloud(ig,l,igcm_h2o_vap)=(zq(ig,l,igcm_h2o_vap) & -zq0(ig,l,igcm_h2o_vap))/ptimestep pdqcloud(ig,l,igcm_h2o_ice) = & (zq(ig,l,igcm_h2o_ice) - zq0(ig,l,igcm_h2o_ice))/ptimestep lw=(2834.3-0.28*(zt(ig,l)-To)-0.004*(zt(ig,l)-To)**2)*1.e+3 pdtcloud(ig,l)=-pdqcloud(ig,l,igcm_h2o_vap)*lw/cpp end do end do c------------------------------------------------------------------ c TEST_JBM IF (ngrid.eq.1) THEN call WRITEDIAGFI(ngrid,"mcond","h2o condensed mass","kg",1, & Mcon_out) call WRITEDIAGFI(ngrid,"rdusttyp","rdusttyp","m",1, & rdusttyp) call WRITEDIAGFI(ngrid,"ccntyp","ccntyp","kg-1",1, & ccntyp) ENDIF c------------------------------------------------------------------ return end