source: trunk/LMDZ.GENERIC/libf/phystd/vdifc.F @ 799

      subroutine vdifc(ngrid,nlay,nq,rnat,ppopsk,         
     &     ptimestep,pcapcal,lecrit,                        
     &     pplay,pplev,pzlay,pzlev,pz0,
     &     pu,pv,ph,pq,ptsrf,pemis,pqsurf,
     &     pdufi,pdvfi,pdhfi,pdqfi,pfluxsrf,
     &     pdudif,pdvdif,pdhdif,pdtsrf,sensibFlux,pq2,
     &     pdqdif,pdqsdif,lastcall)

      use watercommon_h, only : RLVTT, T_h2O_ice_liq, RCPD, mx_eau_sol
      use radcommon_h, only : sigma
      USE surfdat_h
      USE comgeomfi_h
      USE tracer_h

      implicit none

!==================================================================
!     
!     Purpose
!     -------
!     Turbulent diffusion (mixing) for pot. T, U, V and tracers
!     
!     Implicit scheme
!     We start by adding to variables x the physical tendencies
!     already computed. We resolve the equation:
!
!     x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
!     
!     Authors
!     ------- 
!     F. Hourdin, F. Forget, R. Fournier (199X)
!     R. Wordsworth, B. Charnay (2010)
!     
!==================================================================

!-----------------------------------------------------------------------
!     declarations
!     ------------

#include "dimensions.h"
#include "dimphys.h"
#include "comcstfi.h"
#include "callkeys.h"

!     arguments
!     ---------
      INTEGER ngrid,nlay
      REAL ptimestep
      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
      REAL ptsrf(ngrid),pemis(ngrid)
      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
      REAL pfluxsrf(ngrid)
      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
      REAL pdtsrf(ngrid),sensibFlux(ngrid),pcapcal(ngrid)
      REAL pq2(ngrid,nlay+1)
      
      integer rnat(ngrid)      

!     Arguments added for condensation
      REAL ppopsk(ngrid,nlay)
      logical lecrit
      REAL pz0

!     Tracers
!     --------
      integer nq 
      real pqsurf(ngrid,nq)
      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 
      real pdqdif(ngrid,nlay,nq) 
      real pdqsdif(ngrid,nq) 
      
!     local
!     -----
      integer ilev,ig,ilay,nlev

      REAL z4st,zdplanck(ngrid)
      REAL zkv(ngrid,nlayermx+1),zkh(ngrid,nlayermx+1)
      REAL zcdv(ngrid),zcdh(ngrid)
      REAL zcdv_true(ngrid),zcdh_true(ngrid)
      REAL zu(ngrid,nlayermx),zv(ngrid,nlayermx)
      REAL zh(ngrid,nlayermx)
      REAL ztsrf2(ngrid)
      REAL z1(ngrid),z2(ngrid)
      REAL za(ngrid,nlayermx),zb(ngrid,nlayermx)
      REAL zb0(ngrid,nlayermx)
      REAL zc(ngrid,nlayermx),zd(ngrid,nlayermx)
      REAL zcst1
      REAL zu2!, a
      REAL zcq(ngrid,nlayermx),zdq(ngrid,nlayermx)
      REAL evap(ngrid)
      REAL zcq0(ngrid),zdq0(ngrid)
      REAL zx_alf1(ngrid),zx_alf2(ngrid)

      LOGICAL firstcall
      SAVE firstcall
      
      LOGICAL lastcall

!     variables added for CO2 condensation
!     ------------------------------------
      REAL hh                   !, zhcond(ngrid,nlayermx)
!     REAL latcond,tcond1mb
!     REAL acond,bcond
!     SAVE acond,bcond
!     DATA latcond,tcond1mb/5.9e5,136.27/

!     Tracers
!     -------
      INTEGER iq
      REAL zq(ngrid,nlayermx,nq)
      REAL zq1temp(ngrid)
      REAL rho(ngrid)         ! near-surface air density
      REAL qsat(ngrid)
      DATA firstcall/.true./
      REAL kmixmin

!     Variables added for implicit latent heat inclusion
!     --------------------------------------------------
      real latconst, dqsat(ngrid), qsat_temp1, qsat_temp2
      real z1_Tdry(ngrid), z2_Tdry(ngrid)
      real z1_T(ngrid), z2_T(ngrid)
      real zb_T(ngrid)
      real zc_T(ngrid,nlayermx)
      real zd_T(ngrid,nlayermx)
      real lat1(ngrid), lat2(ngrid)
      real surfh2otot
      logical surffluxdiag
      integer isub ! sub-loop for precision

      integer ivap, iice ! also make liq for clarity on surface...
      save ivap, iice

      real, parameter :: karman=0.4
      real cd0, roughratio

      logical forceWC
      real masse, Wtot, Wdiff

      real dqsdif_total(ngrid) 
      real zq0(ngrid) 

      forceWC=.true.
!      forceWC=.false.


!     Coherence test
!     --------------

      IF (firstcall) THEN
!     To compute: Tcond= 1./(bcond-acond*log(.0095*p)) (p in pascal)
!     bcond=1./tcond1mb
!     acond=r/latcond
!     PRINT*,'In vdifc: Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
!     PRINT*,'          acond,bcond',acond,bcond

         if(water)then
!                iliq=igcm_h2o_vap
                ivap=igcm_h2o_vap
                iice=igcm_h2o_ice ! simply to make the code legible               
                                  ! to be generalised later
         endif

         firstcall=.false.
      ENDIF

!-----------------------------------------------------------------------
!     1. Initialisation
!     -----------------

      nlev=nlay+1

!     Calculate rho*dz and dt*rho/dz=dt*rho**2 g/dp
!     with rho=p/RT=p/ (R Theta) (p/ps)**kappa
!     ---------------------------------------------

      DO ilay=1,nlay
         DO ig=1,ngrid
            za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g
         ENDDO
      ENDDO

      zcst1=4.*g*ptimestep/(R*R)
      DO ilev=2,nlev-1
         DO ig=1,ngrid
            zb0(ig,ilev)=pplev(ig,ilev)*
     s           (pplev(ig,1)/pplev(ig,ilev))**rcp /
     s           (ph(ig,ilev-1)+ph(ig,ilev))
            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/
     s           (pplay(ig,ilev-1)-pplay(ig,ilev))
         ENDDO
      ENDDO
      DO ig=1,ngrid
         zb0(ig,1)=ptimestep*pplev(ig,1)/(R*ptsrf(ig))
      ENDDO

      dqsdif_total(:)=0.0

!-----------------------------------------------------------------------
!     2. Add the physical tendencies computed so far
!     ----------------------------------------------

      DO ilev=1,nlay
         DO ig=1,ngrid
            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
         ENDDO
      ENDDO
      if(tracer) then
         DO iq =1, nq
            DO ilev=1,nlay
               DO ig=1,ngrid
                  zq(ig,ilev,iq)=pq(ig,ilev,iq) + 
     &                 pdqfi(ig,ilev,iq)*ptimestep
               ENDDO
            ENDDO
         ENDDO
      end if

!-----------------------------------------------------------------------
!     3. Turbulence scheme
!     --------------------
!
!     Source of turbulent kinetic energy at the surface
!     ------------------------------------------------- 
!     Formula is Cd_0 = (karman / log[1+z1/z0])^2

      DO ig=1,ngrid
         roughratio = 1.E+0 + pzlay(ig,1)/pz0
         cd0 = karman/log(roughratio)
         cd0 = cd0*cd0
         zcdv_true(ig) = cd0
         zcdh_true(ig) = cd0
      ENDDO

      DO ig=1,ngrid
         zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
         zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
         zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
      ENDDO

!     Turbulent diffusion coefficients in the boundary layer
!     ------------------------------------------------------ 

      call vdif_kc(ngrid,ptimestep,g,pzlev,pzlay
     &     ,pu,pv,ph,zcdv_true
     &     ,pq2,zkv,zkh)

!     Adding eddy mixing to mimic 3D general circulation in 1D
!     R. Wordsworth & F. Forget (2010)
      if ((ngrid.eq.1)) then
         kmixmin = 1.0e-2       ! minimum eddy mix coeff in 1D
         do ilev=1,nlay
            do ig=1,ngrid
               !zkh(ig,ilev) = 1.0
               zkh(ig,ilev) = max(kmixmin,zkh(ig,ilev))
               zkv(ig,ilev) = max(kmixmin,zkv(ig,ilev))
            end do
         end do
      end if

!-----------------------------------------------------------------------
!     4. Implicit inversion of u
!     --------------------------

!     u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
!     avec
!     /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
!     et
!     dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
!     donc les entrees sont /zcdv/ pour la condition a la limite sol
!     et /zkv/ = Ku
      
      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
      CALL multipl(ngrid,zcdv,zb0,zb)

      DO ig=1,ngrid
         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
      ENDDO

      DO ilay=nlay-1,1,-1
         DO ig=1,ngrid
            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+
     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
         ENDDO
      ENDDO

      DO ig=1,ngrid
         zu(ig,1)=zc(ig,1)
      ENDDO
      DO ilay=2,nlay
         DO ig=1,ngrid
            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
         ENDDO
      ENDDO

!-----------------------------------------------------------------------
!     5. Implicit inversion of v
!     --------------------------

!     v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
!     avec
!     /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
!     et
!     dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
!     donc les entrees sont /zcdv/ pour la condition a la limite sol
!     et /zkv/ = Kv

      DO ig=1,ngrid
         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
      ENDDO

      DO ilay=nlay-1,1,-1
         DO ig=1,ngrid
            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+
     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
         ENDDO
      ENDDO

      DO ig=1,ngrid
         zv(ig,1)=zc(ig,1)
      ENDDO
      DO ilay=2,nlay
         DO ig=1,ngrid
            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
         ENDDO
      ENDDO

!----------------------------------------------------------------------------
!     6. Implicit inversion of h, not forgetting the coupling with the ground

!     h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
!     avec
!     /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
!     et
!     dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
!     donc les entrees sont /zcdh/ pour la condition de raccord au sol
!     et /zkh/ = Kh

!     Using the wind modified by friction for lifting and sublimation
!     ---------------------------------------------------------------
         DO ig=1,ngrid
            zu2      = zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
            zcdv(ig) = zcdv_true(ig)*sqrt(zu2)
            zcdh(ig) = zcdh_true(ig)*sqrt(zu2)
         ENDDO

      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
      CALL multipl(ngrid,zcdh,zb0,zb)

      DO ig=1,ngrid
         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
      ENDDO

      DO ilay=nlay-1,2,-1
         DO ig=1,ngrid
            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
     &           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+
     &           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
         ENDDO
      ENDDO

      DO ig=1,ngrid
         z1(ig)=1./(za(ig,1)+zb(ig,1)+
     &        zb(ig,2)*(1.-zd(ig,2)))
         zc(ig,1)=(za(ig,1)*zh(ig,1)+
     &        zb(ig,2)*zc(ig,2))*z1(ig)
         zd(ig,1)=zb(ig,1)*z1(ig)
      ENDDO

!     Calculate (d Planck / dT) at the interface temperature
!     ------------------------------------------------------

      z4st=4.0*sigma*ptimestep
      DO ig=1,ngrid
         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
      ENDDO

!     Calculate temperature tendency at the interface (dry case)
!     ----------------------------------------------------------
!     Sum of fluxes at interface at time t + \delta t gives change in T:
!       radiative fluxes
!       turbulent convective (sensible) heat flux
!       flux (if any) from subsurface

      if(.not.water) then

         DO ig=1,ngrid

            z1(ig) = pcapcal(ig)*ptsrf(ig) + cpp*zb(ig,1)*zc(ig,1)
     &           + zdplanck(ig)*ptsrf(ig) + pfluxsrf(ig)*ptimestep
            z2(ig) = pcapcal(ig) + cpp*zb(ig,1)*(1.-zd(ig,1)) 
     &           +zdplanck(ig)
            ztsrf2(ig) = z1(ig) / z2(ig)
            pdtsrf(ig) = (ztsrf2(ig) - ptsrf(ig))/ptimestep
            zh(ig,1)   = zc(ig,1) + zd(ig,1)*ztsrf2(ig)
         ENDDO

!     Recalculate temperature to top of atmosphere, starting from ground
!     ------------------------------------------------------------------

         DO ilay=2,nlay
            DO ig=1,ngrid
               hh = zh(ig,ilay-1)
               zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh
            ENDDO
         ENDDO

      endif                     ! not water

!-----------------------------------------------------------------------
!     TRACERS (no vapour)
!     -------

      if(tracer) then

!     Calculate vertical flux from the bottom to the first layer (dust)
!     -----------------------------------------------------------------
         do ig=1,ngrid  
            rho(ig) = zb0(ig,1) /ptimestep
         end do

         call zerophys(ngrid*nq,pdqsdif)

!     Implicit inversion of q
!     -----------------------
         do iq=1,nq 

            if (iq.ne.igcm_h2o_vap) then

               DO ig=1,ngrid
                  z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
                  zcq(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
                  zdq(ig,nlay)=zb(ig,nlay)*z1(ig)
               ENDDO 
            
               DO ilay=nlay-1,2,-1
                  DO ig=1,ngrid
                     z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
     &                    zb(ig,ilay+1)*(1.-zdq(ig,ilay+1)))
                     zcq(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
     &                    zb(ig,ilay+1)*zcq(ig,ilay+1))*z1(ig)
                     zdq(ig,ilay)=zb(ig,ilay)*z1(ig)
                  ENDDO
               ENDDO

               if ((water).and.(iq.eq.iice)) then
                  ! special case for water ice tracer: do not include
                  ! h2o ice tracer from surface (which is set when handling
                  ! h2o vapour case (see further down).
                  ! zb(ig,1)=0 if iq ne ivap
                  DO ig=1,ngrid
                     z1(ig)=1./(za(ig,1)+
     &                    zb(ig,2)*(1.-zdq(ig,2)))
                     zcq(ig,1)=(za(ig,1)*zq(ig,1,iq)+
     &                    zb(ig,2)*zcq(ig,2))*z1(ig)
                  ENDDO
               else             ! general case
                  DO ig=1,ngrid
                     z1(ig)=1./(za(ig,1)+
     &                    zb(ig,2)*(1.-zdq(ig,2)))
                     zcq(ig,1)=(za(ig,1)*zq(ig,1,iq)+
     &                    zb(ig,2)*zcq(ig,2)
     &                    +(-pdqsdif(ig,iq))*ptimestep)*z1(ig)
                          ! tracer flux from surface
                          ! currently pdqsdif always zero here,
                          ! so last line is superfluous
                  enddo
               endif            ! of if (water.and.(iq.eq.igcm_h2o_ice))


!     Starting upward calculations for simple tracer mixing (e.g., dust)
               do ig=1,ngrid
                  zq(ig,1,iq)=zcq(ig,1)
               end do

               do ilay=2,nlay
                  do ig=1,ngrid
                     zq(ig,ilay,iq)=zcq(ig,ilay)+
     $                    zdq(ig,ilay)*zq(ig,ilay-1,iq)
                  end do
               end do

            endif               ! if (iq.ne.igcm_h2o_vap)

!     Calculate temperature tendency including latent heat term
!     and assuming an infinite source of water on the ground
!     ------------------------------------------------------------------

            if (water.and.(iq.eq.igcm_h2o_vap)) then 
            
               ! compute evaporation efficiency
               do ig = 1, ngrid
                  if(rnat(ig).eq.1)then
                     dryness(ig)=pqsurf(ig,ivap)+pqsurf(ig,iice) 
                     dryness(ig)=MIN(1.,2*dryness(ig)/mx_eau_sol)
                     dryness(ig)=MAX(0.,dryness(ig))
                  endif
               enddo

               do ig=1,ngrid

                ! Calculate the value of qsat at the surface (water)
                call watersat(ptsrf(ig),pplev(ig,1),qsat(ig))
                call watersat(ptsrf(ig)-0.0001,pplev(ig,1),qsat_temp1)
                call watersat(ptsrf(ig)+0.0001,pplev(ig,1),qsat_temp2)
                dqsat(ig)=(qsat_temp2-qsat_temp1)/0.0002
                ! calculate dQsat / dT by finite differences
                ! we cannot use the updated temperature value yet...
 
               enddo

! coefficients for q

               do ig=1,ngrid
                  z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
                  zcq(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
                  zdq(ig,nlay)=zb(ig,nlay)*z1(ig)
               enddo 
            
               do ilay=nlay-1,2,-1
                  do ig=1,ngrid
                     z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
     $                    zb(ig,ilay+1)*(1.-zdq(ig,ilay+1)))
                     zcq(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
     $                    zb(ig,ilay+1)*zcq(ig,ilay+1))*z1(ig)
                     zdq(ig,ilay)=zb(ig,ilay)*z1(ig)
                  enddo
               enddo

               do ig=1,ngrid
                  z1(ig)=1./(za(ig,1)+zb(ig,1)*dryness(ig)+
     $                 zb(ig,2)*(1.-zdq(ig,2)))
                  zcq(ig,1)=(za(ig,1)*zq(ig,1,iq)+
     $                 zb(ig,2)*zcq(ig,2))*z1(ig)
                  zdq(ig,1)=dryness(ig)*zb(ig,1)*z1(ig)
               enddo

! calculation of h0 and h1
               do ig=1,ngrid
                  zdq0(ig) = dqsat(ig)
                  zcq0(ig) = qsat(ig)-dqsat(ig)*ptsrf(ig)

                  z1(ig) = pcapcal(ig)*ptsrf(ig) +cpp*zb(ig,1)*zc(ig,1)
     &                 + zdplanck(ig)*ptsrf(ig) + pfluxsrf(ig)*ptimestep 
     &                 +  zb(ig,1)*dryness(ig)*RLVTT*
     &                 ((zdq(ig,1)-1.0)*zcq0(ig)+zcq(ig,1))

                  z2(ig) = pcapcal(ig) + cpp*zb(ig,1)*(1.-zd(ig,1))
     &                 +zdplanck(ig)
     &                 +zb(ig,1)*dryness(ig)*RLVTT*zdq0(ig)*
     &                 (1.0-zdq(ig,1))

                  ztsrf2(ig) = z1(ig) / z2(ig)
                  pdtsrf(ig) = (ztsrf2(ig) - ptsrf(ig))/ptimestep
                  zh(ig,1)   = zc(ig,1) + zd(ig,1)*ztsrf2(ig)
               enddo

! calculation of qs and q1
               do ig=1,ngrid
                  zq0(ig)     = zcq0(ig)+zdq0(ig)*ztsrf2(ig)
                  zq(ig,1,iq) = zcq(ig,1)+zdq(ig,1)*zq0(ig)
               enddo

! calculation of evaporation              
               do ig=1,ngrid 
                  evap(ig)= zb(ig,1)*dryness(ig)*(zq(ig,1,ivap)-zq0(ig))
                  dqsdif_total(ig)=evap(ig)
               enddo

! recalculate temperature and q(vap) to top of atmosphere, starting from ground
               do ilay=2,nlay
                  do ig=1,ngrid
                     zq(ig,ilay,iq)=zcq(ig,ilay)
     &                    +zdq(ig,ilay)*zq(ig,ilay-1,iq)
                     zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zh(ig,ilay-1)
                  end do
               end do

               do ig=1,ngrid

!     --------------------------------------------------------------------------
!     On the ocean, if T > 0 C then the vapour tendency must replace the ice one
!     The surface vapour tracer is actually liquid. To make things difficult.

                  if (rnat(ig).eq.0) then ! unfrozen ocean
                     
                     pdqsdif(ig,ivap)=dqsdif_total(ig)/ptimestep
                     pdqsdif(ig,iice)=0.0


                  elseif (rnat(ig).eq.1) then ! (continent)

!     --------------------------------------------------------
!     Now check if we've taken too much water from the surface
!     This can only occur on the continent 

!     If water is evaporating / subliming, we take it from ice before liquid
!     -- is this valid??
                     if(dqsdif_total(ig).lt.0)then
                        pdqsdif(ig,iice)=dqsdif_total(ig)/ptimestep
                        pdqsdif(ig,iice)=max(-pqsurf(ig,iice)/ptimestep
     &                       ,pdqsdif(ig,iice))
                     endif
                     ! sublimation only greater than qsurf(ice)
                     ! ----------------------------------------
                     ! we just convert some liquid to vapour too
                     ! if latent heats are the same, no big deal
                     if (-dqsdif_total(ig).gt.pqsurf(ig,iice))then            
                       pdqsdif(ig,iice) = -pqsurf(ig,iice)/ptimestep ! removes all the ice!
                       pdqsdif(ig,ivap) = dqsdif_total(ig)/ptimestep
     &                       - pdqsdif(ig,iice) ! take the remainder from the liquid instead
                       pdqsdif(ig,ivap) = max(-pqsurf(ig,ivap)/ptimestep
     &                       ,pdqsdif(ig,ivap))
                    endif

                 endif          ! if (rnat.ne.1)

!     If water vapour is condensing, we must decide whether it forms ice or liquid.
                 if(dqsdif_total(ig).gt.0)then ! a bug was here!
                    if(ztsrf2(ig).gt.T_h2O_ice_liq)then
                       pdqsdif(ig,iice)=0.0
                       pdqsdif(ig,ivap)=dqsdif_total(ig)/ptimestep
                    else
                       pdqsdif(ig,iice)=dqsdif_total(ig)/ptimestep
                       pdqsdif(ig,ivap)=0.0
                    endif
                 endif

              end do            ! of DO ig=1,ngrid
           endif                ! if (water et iq=ivap)
        end do                  ! of do iq=1,nq
      endif                     ! traceur


!-----------------------------------------------------------------------
!     8. Final calculation of the vertical diffusion tendencies
!     -----------------------------------------------------------------

      do ilev = 1, nlay
         do ig=1,ngrid
            pdudif(ig,ilev)=(zu(ig,ilev)-
     &           (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep))/ptimestep
            pdvdif(ig,ilev)=(zv(ig,ilev)-
     &           (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep))/ptimestep
            hh = ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep 

            pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep
         enddo
      enddo

      DO ig=1,ngrid  ! computing sensible heat flux (atm => surface)
         sensibFlux(ig)=cpp*zb(ig,1)/ptimestep*(zh(ig,1)-ztsrf2(ig))
      ENDDO      

      if (tracer) then
         do iq = 1, nq
            do ilev = 1, nlay
               do ig=1,ngrid
                  pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-
     &           (pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep))/
     &           ptimestep
               enddo
            enddo
         enddo

         if(water.and.forceWC)then ! force water conservation in model
                                   ! we calculate the difference and add it to the ground
                                   ! this is ugly and should be improved in the future
            do ig=1,ngrid
               Wtot=0.0
               do ilay=1,nlay
                  masse = (pplev(ig,ilay) - pplev(ig,ilay+1))/g
!                  Wtot=Wtot+masse*(zq(ig,ilay,iice)-
!     &                 (pq(ig,ilay,iice)+pdqfi(ig,ilay,iice)*ptimestep))
                  Wtot=Wtot+masse*(zq(ig,ilay,ivap)-
     &                 (pq(ig,ilay,ivap)+pdqfi(ig,ilay,ivap)*ptimestep))
               enddo
               Wdiff=Wtot/ptimestep+pdqsdif(ig,ivap)+pdqsdif(ig,iice)

               if(ztsrf2(ig).gt.T_h2O_ice_liq)then
                  pdqsdif(ig,ivap)=pdqsdif(ig,ivap)-Wdiff
               else
                  pdqsdif(ig,iice)=pdqsdif(ig,iice)-Wdiff
               endif
            enddo

         endif

      endif 

      if(water)then
      call writediagfi(ngrid,'beta','Dryness coefficient',' ',2,dryness)
      endif

!      if(lastcall)then
!        if(ngrid.eq.1)then
!           print*,'Saving k.out...'
!           OPEN(12,file='k.out',form='formatted')
!           DO ilay=1,nlay
!              write(12,*) zkh(1,ilay), pplay(1,ilay)
!           ENDDO
!           CLOSE(12)
!         endif
!      endif


      return
      end