SUBROUTINE cocloud(ngrid,nlay,naersize, ptimestep, & pplev,pplay,pdpsrf,pzlev,pzlay,pt,pdt, & pq,pdq,pdqcloud,pdqscloud,pdtcloud, & nq,rice_co) use comgeomfi_h use comcstfi_mod, only: pi, g, cpp use tracer_h, only: igcm_co_gas, igcm_co_ice, rho_co_ice, lw_co use callkeys_mod, only: Nmix_co IMPLICIT NONE !======================================================================= ! Treatment of saturation of CARBON MONOXIDE ! ! ! Modif de zq si saturation dans l'atmosphere ! si zq(ig,l)> zqsat(ig,l) -> zq(ig,l)=zqsat(ig,l) ! Le test est effectue de bas en haut. CO condensee ! (si saturation) est remise dans la couche en dessous. ! CO condensee dans la couche du bas est deposee a la surface ! ! !======================================================================= !----------------------------------------------------------------------- ! declarations: ! ------------- ! Inputs: ! ------ INTEGER ngrid,nlay 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 pdpsrf(ngrid) ! tendance surf pressure 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) integer naersize ! nombre de traceurs radiativement actifs (=naerkind) integer nq ! nombre de traceurs ! Outputs: ! ------- real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation CO(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 REAL rice_co(ngrid,nlay) ! Ice mass mean radius (m) ! (r_c in montmessin_2004) ! local: ! ------ ! REAL Nmix ! Cloud condensation nuclei ! parameter (Nmix=1.E2) ! /kg ! parameter (Nmix=1) ! /kg real rnuclei ! Nuclei geometric mean radius (m) parameter (rnuclei=2.E-7) ! m REAL CBRT EXTERNAL CBRT INTEGER ig,l REAL zq(ngrid,nlay,nq) ! local value of tracers REAL zq0(ngrid,nlay,nq) ! local initial value of tracers REAL zqsat(ngrid,nlay) ! saturation REAL zt(ngrid,nlay) ! local value of temperature REAL vecnull(ngrid*nlay) REAL masse (ngrid,nlay) REAL epaisseur (ngrid,nlay) ! REAL rfinal ! Ice crystal radius after condensation(m) REAL*8 dzq ! masse de glace echangee (kg/kg) REAL lw !Latent heat of sublimation (J.kg-1) LOGICAL,SAVE :: firstcall=.true. ! indexes of co gas, co ice and dust tracers: INTEGER,SAVE :: i_co=0 ! co gas INTEGER,SAVE :: i_ice=0 ! co ice ! ** un petit test de coherence ! -------------------------- IF (firstcall) THEN IF(ngrid.NE.ngrid) THEN PRINT*,'STOP dans cocloud' PRINT*,'probleme de dimensions :' PRINT*,'ngrid =',ngrid PRINT*,'ngrid =',ngrid STOP ENDIF if (nq.gt.nq) then write(*,*) 'stop in cocloud (nq.gt.nq)!' write(*,*) 'nq=',nq,' nq=',nq stop endif ! MELANIE : change these line i_co=igcm_co_gas i_ice=igcm_co_ice write(*,*) "cocloud: i_co=",i_co write(*,*) " i_ice=",i_ice firstcall=.false. ENDIF ! of IF (firstcall) !----------------------------------------------------------------------- ! 1. initialisation ! ----------------- ! On "update" la valeur de q(nq) (co vapor) et temperature. ! On effectue qqes calculs preliminaires sur les couches : ! masse (kg.m-2), epaisseur(m). do l=1,nlay do ig=1,ngrid zq(ig,l,i_co)=pq(ig,l,i_co)+pdq(ig,l,i_co)*ptimestep zq(ig,l,i_co)=max(zq(ig,l,i_co),1.E-30) ! FF 12/2004 zq0(ig,l,i_co)=zq(ig,l,i_co) zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g epaisseur(ig,l)= pzlev(ig,l+1) - pzlev(ig,l) zq(ig,l,i_ice)=pq(ig,l,i_ice)+pdq(ig,l,i_ice)*ptimestep zq(ig,l,i_ice)=max(zq(ig,l,i_ice),0.) ! FF 12/2004 zq0(ig,l,i_ice)=zq(ig,l,i_ice) enddo enddo pdqscloud(1:ngrid,1:nq)=0 pdqcloud(1:ngrid,1:nlay,1:nq)=0 pdtcloud(1:ngrid,1:nlay)=0 vecnull(:)=0 ! ---------------------------------------------- ! ! ! Rapport de melange a saturation dans la couche l : ------- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! do l=1,nlay ! do ig=1,ngrid ! call cosat(zt(ig,l),pplay(ig,l),zqsat(ig,l)) ! write(101,*)'qsat',qsat(ig,l) ! enddo ! enddo call cosat(ngrid*nlay,zt,pplay,zqsat,vecnull,vecnull) ! TEMPORAIRE : ! test sans condensation atmospherique ! do l=1,nlay ! do ig=1,ngrid ! zqsat(ig,l) = zqsat(ig,l) *1000. ! end do ! end do ! call WRITEDIAGFI(ngrid,"qsat_co","qsat_co","unit",3,zqsat) ! do l=1,nlay ! do ig=1,ngrid ! zqsat(ig,l)=0.117*exp((16*568.7/8.314)*(1/90.7 ! & -1/zt(ig,l)))*100000 ! zqsat(ig,l)=(zqsat(ig,l)/pplay(ig,l))*(16/28) ! write(106,*)'zqsat',zqsat(ig,l) ! enddo ! of do ig=1,ngrid ! enddo ! of do l=1,nlay ! taux de condensation (kg/kg/s-1) dans les differentes couches ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ do l=1,nlay do ig=1,ngrid ! call cosat(zt(ig,l),pplay(ig,l),zqsat(ig,l)) if (zq(ig,l,i_co).ge.zqsat(ig,l))then ! Condensation dzq=zq(ig,l,i_co)-zqsat(ig,l) elseif(zq(ig,l,i_co).lt.zqsat(ig,l))then ! Sublimation dzq=-min(zqsat(ig,l)-zq(ig,l,i_co),zq(ig,l,i_ice)) endif ! CO Mass change ! ~~~~~~~~~~~~~~~~~ zq(ig,l,i_ice)=zq(ig,l,i_ice)+dzq zq(ig,l,i_co)=zq(ig,l,i_co)-dzq rice_co(ig,l)=max( CBRT ( (zq(ig,l,i_ice)/rho_co_ice & +Nmix_co*(4./3.)*pi*rnuclei**3.) & /(Nmix_co*4./3.*pi) ), rnuclei) ! CBRT=cube root enddo ! of do ig=1,ngrid enddo ! of do l=1,nlay ! Saturation couche nlay a 2 : ! ~~~~~~~~~~~~~~~~~~~~~~~~~~ ! do l=nlay,2, -1 ! do ig=1,ngrid ! if (zq(ig,l,i_co).gt.zqsat(ig,l))then ! zq(ig,l-1,i_co)= zq(ig,l-1,i_co)+ ! & (zq(ig,l,i_co)-zqsat(ig,l)) ! & *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l)) ! zq(ig,l,i_co)=zqsat(ig,l) ! endif ! enddo ! enddo ! Saturation couche l=1 si pas iceparty ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! do ig=1,ngrid ! if (zq(ig,1,i_co).gt.zqsat(ig,1))then ! pdqscloud(ig,i_ice)=(zq(ig,1,i_co)-zqsat(ig,1)) ! & *(pplev(ig,1)-pplev(ig,2))/(g*ptimestep) ! zq(ig,1,i_co)=zqsat(ig,1) ! endif ! enddo ! Tendance finale ! ~~~~~~~~~~~~~~~ do l=1, nlay do ig=1,ngrid pdqcloud(ig,l,i_co)=(zq(ig,l,i_co) & -zq0(ig,l,i_co))/ptimestep pdqcloud(ig,l,i_ice) = & (zq(ig,l,i_ice) - zq0(ig,l,i_ice))/ptimestep lw=lw_co pdtcloud(ig,l)=-pdqcloud(ig,l,i_co)*lw/cpp end do end do ! A correction if a lot of subliming co fills the 1st layer FF04/2005 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! Then that should not affect the ice particle radius do ig=1,ngrid if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,2)))then if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,3))) & rice_co(ig,2)=rice_co(ig,3) rice_co(ig,1)=rice_co(ig,2) end if end do !************************************************** ! Output --- removed !************************************************** ! NB: for diagnostics use zq(), the updated value of tracers ! Computing ext visible optical depth in each layer RETURN END