!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer, 
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms 
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer 
!version 3 or (at your option) any later version that should be found at: 
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html 
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software; 
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), 
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r diag_ttes
*
#include "model_macros_f.h"
*

      subroutine diag_ttes (tt,es,ni,nj,ki) 1,3
      implicit none
*
      integer ni,nj,ki
      real tt(ni,nj),es(ni,nj)
*
*author
*     M. Desgagne - Spring 2008
*
*revision
* v3_31 - Desgagne M.       - initial version
*
*implicits
#include "glb_ld.cdk"
#include "schm.cdk"
#include "vt1.cdk"
#include "vt0.cdk"
#include "itf_phy_busind.cdk"
*
**
      integer  vmmlod,vmmget
      external vmmlod,vmmget
*
      integer err, key(2), i, j, k, n, keyp_, keyp(phyt_ntr), ninj
      real, dimension (:,:), allocatable :: sum,vt,hu,px
      real trp
      pointer (patrp, trp(LDIST_SHAPE,*))
*
*     ________________________________________________________________
*
      key(1) = VMM_KEY(tt1)
      key(2) = VMM_KEY(qt1)
      err    = vmmlod(key,2)
      err    = VMM_GET_VAR(tt1)
      err    = VMM_GET_VAR(qt1)
*
      allocate ( sum(l_ni,l_nj),vt(l_ni,l_nj),
     $            hu(l_ni,l_nj),px(l_ni,l_nj) )
*
      vt(:,:) = tt1(1:l_ni,1:l_nj,ki)
      keyp_ = VMM_KEY (trt1)
*
      do n=1,phyt_ntr
         keyp(n) = keyp_ + n
      end do
      err = vmmlod (keyp,phyt_ntr)  

      err = vmmget (keyp(1),patrp,trp)
      hu(:,:) = trp(1:l_ni,1:l_nj,ki)
*
      px(:,:) = exp(qt1(1:l_ni,1:l_nj,ki))
*
      ninj = ni*nj
      if (Schm_wload_L) then

         sum = 0.
         do n = 2, h2o_ntr
            err = vmmget(keyp(n),patrp,trp)
            sum(:,:) = sum(:,:) + trp(1:l_ni,1:l_nj,ki)
         enddo
         call mfottvh (tt, vt, hu, sum, ninj, 1, ninj)

      else

         call mfottv ( tt ,vt, hu, ninj, 1, ninj)

      endif
*Out3_satues_L ???

      call mhuaes (es, hu,tt,px,px,3, .true., .false.,ninj,1,ninj)
*
*     ________________________________________________________________
*
      return
      end