Changeset 619 for trunk/LMDZ.MARS/libf

Timestamp:

Apr 13, 2012, 3:15:09 PM (13 years ago)

Author:

acolaitis

Message:

THERMALS: corrected improper tracer conservation that would appear in sharp tracer gradient cases. Tracer conservation is now identical to convective adjustment

Location:

trunk/LMDZ.MARS/libf/phymars

Files:

• calltherm_interface.F90 (modified) (4 diffs)
• thermcell_dqup.F90 (modified) (5 diffs)
• thermcell_main_mars.F90 (modified) (2 diffs)

trunk/LMDZ.MARS/libf/phymars/calltherm_interface.F90

@@ -328 +328 @@
       modname='momentum'
       call thermcell_dqup(ngridmx,nlayermx,ptimestep                &
-     &      ,fm_therm,entr_therm,detr_therm,  &
+     &      ,fm_therm,entr_therm,zfraca,  &
      &     masse,zu,d_u_ajs,modname,zdz)
 
       call thermcell_dqup(ngridmx,nlayermx,ptimestep    &
-     &       ,fm_therm,entr_therm,detr_therm,  &
+     &       ,fm_therm,entr_therm,zfraca,  &
      &     masse,zv,d_v_ajs,modname,zdz)
 
@@ -340 +340 @@
       if (iq .ne. ico2) then
       call thermcell_dqup(ngridmx,nlayermx,ptimestep     &
-     &     ,fm_therm,entr_therm,detr_therm,  &
+     &     ,fm_therm,entr_therm,zfraca,  &
      &    masse,pq_therm(:,:,iq),d_q_ajs(:,:,iq),modname,zdz)
       endif
@@ -349 +349 @@
       modname='tke'
       call thermcell_dqup(ngridmx,nlayermx,ptimestep     &
-     &     ,fm_therm,entr_therm,detr_therm,  &
+     &     ,fm_therm,entr_therm,zfraca,  &
      &    masse,q2_therm,dq2_therm,modname,zdz)
       endif
@@ -459 +459 @@
         call WRITEDIAGFI(ngridmx,'d_t_th',  &
      &         'tendance temp TH','K',1,d_t_ajs)
+        call WRITEDIAGFI(ngridmx,'d_q_th',  &
+     &         'tendance traceur TH','kg/kg',1,d_q_ajs)
         call WRITEDIAGFI(ngridmx,'zmax',  &
      &         'pbl height','m',0,zmaxth)

trunk/LMDZ.MARS/libf/phymars/thermcell_dqup.F90

@@ -1 +1 @@
       subroutine thermcell_dqup(ngrid,nlayer,ptimestep,fm0,entr0,  &
-     &    detr0,masse0,q_therm,dq_therm,charvar,zdz)
+     &    alpha,masse0,q_therm,dq_therm,charvar,zdz)
       implicit none
 
@@ -21 +21 @@
       REAL, INTENT(IN) :: ptimestep
       REAL, INTENT(IN) :: fm0(ngridmx,nlayermx+1)
-      REAL, INTENT(IN) ::entr0(ngridmx,nlayermx),detr0(ngridmx,nlayermx)
+      REAL, INTENT(IN) ::entr0(ngridmx,nlayermx)
       REAL, INTENT(IN) :: q_therm(ngridmx,nlayermx)
       CHARACTER (LEN=20), INTENT(IN) :: charvar
       REAL, INTENT(IN) :: masse0(ngridmx,nlayermx)
       REAL, INTENT(IN) :: zdz(ngridmx,nlayermx)
+      REAL, INTENT(IN) :: alpha(ngridmx,nlayermx+1)
 
 ! ============================ OUTPUTS ===========================
@@ -37 +38 @@
       REAL qd(ngridmx,nlayermx)
       INTEGER ig,k
-      REAL gammaf(ngridmx,nlayermx)
+      REAL gammaf(ngridmx,nlayermx),fmid(ngridmx,nlayermx)
+      REAL gammae(ngridmx,nlayermx)
+      REAL alphamid(ngridmx,nlayermx)
 
 ! =========== Init ==============================================
@@ -48 +51 @@
             if (fm0(ig,k)+entr0(ig,k) .gt. 0.) then
               gammaf(ig,k)=fm0(ig,k)/(fm0(ig,k)+entr0(ig,k))
+              gammae(ig,k)=fm0(ig,k+1)/(fm0(ig,k)+entr0(ig,k))
             else
               gammaf(ig,k)=0.
+              gammae(ig,k)=1.
             endif
          enddo
@@ -57 +62 @@
 ! =========== Updraft ============================================
 
-!      qa(:,1)=q(:,1)
+!      qa(:,1)=q_therm(:,1)
+
 
       do ig=1,ngridmx
          do k=2, nlayermx
- 
-             qa(ig,k)=gammaf(ig,k)*qa(ig,k-1) +(1.-gammaf(ig,k))*q(ig,k)
+
+             qa(ig,k)=gammaf(ig,k)*qa(ig,k-1)+(1.-gammaf(ig,k))*q(ig,k)
 
          enddo
       enddo
 
+! =========== Environnement =======================================
 
+!     q(:,nlayermx)=q_therm(:,nlayermx)
+
+      do ig=1,ngridmx
+         do k=nlayermx-1, 1,-1
+ 
+             q(ig,k)=gammae(ig,k)*q(ig,k+1)+(1.-gammae(ig,k))*qa(ig,k)
+
+         enddo
+      enddo
 
 ! ====== dq ======================================================
 
-!      do ig=1,ngridmx
-!         dq_therm(ig,1)=(detr0(ig,1)*qa(ig,1)+fm0(ig,2)*q(ig,2) &
-!      &               -entr0(ig,1)*q(ig,1)) &
-!      &               *ptimestep/masse0(ig,1)
-!       enddo
-!       do k=2,nlayermx-1
-!         do ig=1, ngridmx
-!         dq_therm(ig,k)=(detr0(ig,k)*qa(ig,k)+fm0(ig,k+1)*q(ig,k+1) &
-!      &               -entr0(ig,k)*q(ig,k)-fm0(ig,k)*q(ig,k))  &
-!      &               *ptimestep/masse0(ig,k)
-!         enddo
-!      enddo
-!
-!         do ig=1, ngridmx
-!         dq_therm(ig,nlayermx)=(detr0(ig,nlayermx)*qa(ig,nlayermx) &
-!      &             -entr0(ig,nlayermx)*q(ig,nlayermx)  &
-!      &               -fm0(ig,nlayermx)*q(ig,nlayermx)) &
-!      &               *ptimestep/masse0(ig,nlayermx)
-!         
-!         enddo
+      dq_therm(:,:)=0.
+      fmid(:,:)=0.
+      alphamid(:,:)=0.
+
+        do ig=1, ngridmx
+           do k=1,nlayermx
+              fmid(ig,k) = 0.5*(fm0(ig,k)+fm0(ig,k+1))
+              alphamid(ig,k) = 0.5*(alpha(ig,k)+alpha(ig,k+1))
+           enddo
+        enddo
 
         do ig=1, ngridmx
            do k=1,nlayermx-1
               dq_therm(ig,k)=-(1./masse0(ig,k))*(  &
-     &           fm0(ig,k+1)*(qa(ig,k+1)-q(ig,k+1)) -   &
-     &           fm0(ig,k)*(qa(ig,k)-q(ig,k))          ) &
+     &   (1.-alphamid(ig,k+1))*fmid(ig,k+1)*(qa(ig,k+1)-q(ig,k+1)) -   &
+     &   (1.-alphamid(ig,k))*fmid(ig,k)*(qa(ig,k)-q(ig,k))          ) &
      &       /zdz(ig,k)
 
            enddo
         enddo
-
       return
       end

trunk/LMDZ.MARS/libf/phymars/thermcell_main_mars.F90

@@ -271 +271 @@
 
       do l=2,nlayermx
-         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
+!         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
+          rhobarz(:,l)=pplev(:,l)/(r*0.5*(pt(:,l)+pt(:,l-1)))
       enddo
 
@@ -1533 +1534 @@
       modname='tracer'
       call thermcell_dqup(ngridmx,nlayermx,ptimestep     &
-     &     ,fm,entr,detr,  &
+     &     ,fm,entr,fraca,  &
      &    masse,pq(:,:,ico2),pdqadj(:,:,ico2),modname,zdzfull)
 !      endif