!-------------------------------------- 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 lesahuo 1,1
#if defined (DOC)
*
***S/R lesahuo  -  Computes perturbation to the specific humidity.
*                  from del(T) and del(T-Td). TL of T branch of mesahuv
*                  where ice phase is ignored.
*
*Author:   L. Fillion - ARMA/CMC - 24 nov 98
*
*Revision:
*           C. Charette - ARMA/SMC - Sep. 2004
*            - Conversion to hybrid vertical coordinate
 
*          Bin He   - ARMA/MRB   - Oct. 2011,
*                   - 4Dvar optimization.
*Arguments:
*          - Output -
*     gomq1 : perturbation to the specific humidity q
*          - Input -
*     gomt  : del T
*     gomq  : del (T-Td)
*
*    -------------------
#endif
      USE modfgat,only : istepobs,nobs,notag

      IMPLICIT NONE
*implicits
#include "comlun.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comgem.cdk"
#include "comdimo.cdk"
#include "comphy.cdk"
#include "commvo.cdk"
#include "commvo1.cdk"
#include "commvog.cdk"
      integer jlev, jobs,iobs 
      real*8 zdeltd,zdeles,znum1,znum2,zdenom,zpresb
      logical llprint
*
**
!
      IF(nobs(istepobs) == 0) RETURN 
C
      LLPRINT = .FALSE.
C
      do  iobs = 1, nobs(istepobs)
         jobs=notag(iobs,istepobs)
 
        do jlev = 1, nflev
c-------del(Td) = delT - del(T-Td)
          zdeltd = gomt(jlev,jobs) - gomq(jlev,jobs)
c------- del(es(Td) = es(Td)*fodle(Td)*del(Td)
          zdeles = estdg(jlev,jobs)*dlnesg(jlev,jobs)*zdeltd
          zpresb = ((vhybinc(jlev) - rptopinc/rprefinc)
     &         /(1.0-rptopinc/rprefinc))**rcoefinc
          znum1 = eps1*rppobs(JLEV,JOBS)
          znum2 = eps1*estdg(jlev,jobs)*zpresb
          zdenom = (rppobs(JLEV,JOBS)-eps2*estdg(jlev,jobs))**2
          gomq1(jlev,jobs) = rqgfac(jlev,jobs)*
     &         (znum1*zdeles-znum2*gomps(1,jobs))/zdenom
          if(llprint .and. jobs.eq.1) then
            write(nulout,*)'lesahuo:jobs,jlev,zdeltd,zdeles,gomt,gomq '
     &          ,jobs,jlev,zdeltd,zdeles,gomt(jlev,jobs),gomq(jlev,jobs)
            write(nulout,*)'estdg,dlnesg,eps1,eps2,rppobs,vlev '
     &           ,estdg(jlev,jobs),dlnesg(jlev,jobs),eps1,eps2
     &           ,rppobs(JLEV,JOBS),vlev(jlev)
            write(nulout,*)'znum1,znum2,zdenom,gomq1,gomps,rqgfac '
     &           ,znum1,znum2,zdenom,gomq1(jlev,jobs),gomps(1,jobs)
     &           ,rqgfac(jlev,jobs)
          endif
        enddo
      enddo
c
      return
      end