!-------------------------------------- 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 --------------------------------------
!
*

      subroutine lq2esgd ( pesinc, ptg, pqg, ppsg, ppt, kni, knj, knk ) 1
*
***S/R lq2esgd  -  Computes increments of ES=T-TD FROM T AND lnq
*                  increments in Grid-Point Space.
*
#if defined (DOC)
*
*Author: L. Fillion - ARMA/AES - 19 Nov 98 - Grid-Point version of
C LMHUAESV
*
*Revision:
*          C. Charette *ARMA/AES  Nov 1998
*                       - Add llprint for diagnostics
*          Y.J. Rochon and Cecilien Charette - SMC - Sept 2004
*            - Conversion to hybrid vertical coordinate
*            - Use of new function FOTW8 FODTW8(in fintern8.cdk)
*              Follow WMO convention on T-Td vs HU relationship)
*
*Arguments:
*
* Out:
*      pesinc : Dew-point depression increment on the analysis grid
* IN:
*      ptg    : Background temperature on the analysis grid
*      pqg    : Background specific-humidity on the analysis grid
*      ppsg   : Background surface-pressure (Pa) on the analysis grid
*      ppt    : Pressure (Pa) at the top. (2D grid-point field)
*
*Object:   For Postprocessing analysis increment (called by DIAG3DVAR):
*          calculate the TLM OF dew point depression from TLM specific
*          humidity, temperature and pressure.  No ice phase is
*          CONSIDERED.
*
#endif
      IMPLICIT NONE
      integer kni,knj,knk
      real*8 pesinc(kni,knk,knj)
      real*8 ptg(kni,knk,knj),pqg(kni,knk,knj), ppsg(kni,knj)
      real*8 ppt(kni,knj)
*IMPLICITES
#include "comlun.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comgem.cdk"
#include "comgd0.cdk"
*
      logical llprint
      integer ji,jj,jk,jij
      REAL*8 ZE, ZEL, ZCTE, ZDEN, ZTD, ZTDL, ZGAMMA, zpres
      INTEGER IERR,ILEN
      EXTERNAL HPDEALLC, HPALLOC
      real*8 zpresa,zpresb
C
*
#include "comphy.cdk"
#include "dinternv.cdk"
#include "finternva.cdk"
#include "finternvl.cdk"
#include "dintern8.cdk"
#include "fintern8.cdk"
**
      WRITE(nulout,FMT='(/,4X,"Starting LQ2ESGD",//)')
*
      llprint = .false.
*
      do jk=1,knk
        do ji=1,kni
          do jj=1,knj
            jij=(ji-1)*knj+jj
            zpresb = ((vhybinc(jk) - rptopinc/rprefinc)
     &                /(1.0-rptopinc/rprefinc))**rcoefinc
            zpresa = rprefinc * (vhybinc(jk)-zpresb)
            zpres  = zpresa + zpresb*ppsg(ji,jj)
*
*          First do the forward branch to get saturated vapour pressure
*          from q
*
            ZE = FOEFQ8(pqg(ji,jk,jj), zpres)
*
*          TLM of the saturated vapor pressure from q (specific humidity)
*
            ZEL = FOEFQL(q0(ji,jk,jj),gps0(ji,1,jj)
     &           ,pqg(ji,jk,jj),zpres,vhybinc(jk))
*
*          TLM of the dewpoint temperature calculation
*
C          From Teten's relation
C
            ZTD=FOTW8(ZE)
            ZGAMMA=FODTW8(ZTD,ZE)
            ZTDL = ZGAMMA*ZEL
*
            pesinc(ji,jk,jj) = tt0(ji,jk,jj) - ZTDL
*
********************************************************************
c           if(llprint .and. ji .eq. 221 .and. jj .eq. 27) then
c           write(nulout,*)' lq2esgd:ji,jj,jk,ZTD  '
c     &          ,ji,jj,jk,ZE,ZCTE,ZDEN,ZTD,TRPL
c           write(nulout,*)' lq2esgd: ji,jj,jk,tt0,q0 '
c     &          ,ji,jj,jk,tt0(ji,jk,jj),q0(ji,jk,jj)
c           write(nulout,*)' lq2esgd:ji,jj,jk,ZE,ZCTE,ZDEN,ZTD,TRPL  '
c     &          ,ji,jj,jk,ZE,ZCTE,ZDEN,ZTD,TRPL
c           write(nulout,*)' lq2esgd:ppsg,pqg,zpres,vhybinc(jk)'
c     &               ,ppsg(ji,jj),pqg(ji,jk,jj),zpres,vhybinc(jk)
c           write(nulout,*)' lq2esgd:ji,jj,jk,ZGAMMA,ZEL,ZTDL,pesinc  '
c     &          ,ji,jj,jk,ZGAMMA,ZEL,ZTDL,pesinc(ji,jk,jj)
c           endif
*********************************************************************
*
          enddo
        enddo
      enddo
*
      RETURN
      END