MODULE lmdz_thermcell_dtke CONTAINS subroutine thermcell_dtke(ngrid,nlay,nsrf,ptimestep,fm0,entr0, & & rg,pplev,tke) USE print_control_mod, ONLY: prt_level implicit none !======================================================================= ! ! Calcul du transport verticale dans la couche limite en presence ! de "thermiques" explicitement representes ! calcul du dq/dt une fois qu'on connait les ascendances ! !======================================================================= integer, intent(in) :: ngrid,nlay,nsrf real, intent(in) :: ptimestep real, dimension(ngrid,nlay), intent(in) :: entr0 real, dimension(ngrid,nlay+1), intent(in) :: fm0,pplev real, intent(in) :: rg real, intent(inout) :: tke(ngrid,nlay+1,nsrf) real, dimension(ngrid,nlay) :: masse0,detr0, masse,entr,detr real, dimension(ngrid,nlay+1) :: fm,wqd,q,qa integer lev_out ! niveau pour les print real :: zzm integer ig,k integer isrf lev_out=0 !print*,'thermcell_dtke' if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0' ! calcul du detrainement do k=1,nlay detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k) masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG enddo ! Decalage vertical des entrainements et detrainements. masse(:,1)=0.5*masse0(:,1) entr(:,1)=0.5*entr0(:,1) detr(:,1)=0.5*detr0(:,1) fm(:,1)=0. do k=1,nlay-1 masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1)) entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1)) detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1)) fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k) enddo fm(:,nlay+1)=0. do isrf=1,nsrf q(:,:)=tke(:,:,isrf) ! calcul de la valeur dans les ascendances do ig=1,ngrid qa(ig,1)=q(ig,1) enddo if (1==1) then do k=2,nlay do ig=1,ngrid if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. & & 1.e-5*masse(ig,k)) then qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) & & /(fm(ig,k+1)+detr(ig,k)) else qa(ig,k)=q(ig,k) endif if (qa(ig,k).lt.0.) then ! print*,'qa<0!!!' endif if (q(ig,k).lt.0.) then ! print*,'q<0!!!' endif enddo enddo ! Calcul du flux subsident do k=2,nlay do ig=1,ngrid wqd(ig,k)=fm(ig,k)*q(ig,k) if (wqd(ig,k).lt.0.) then ! print*,'wqd<0!!!' endif enddo enddo do ig=1,ngrid wqd(ig,1)=0. wqd(ig,nlay+1)=0. enddo ! Calcul des tendances do k=1,nlay do ig=1,ngrid q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k) & & -wqd(ig,k)+wqd(ig,k+1)) & & *ptimestep/masse(ig,k) enddo enddo endif tke(:,:,isrf)=q(:,:) enddo return end END MODULE lmdz_thermcell_dtke