!-------------------------------------- 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 oda_HT1obs(CDFAM) 1
#if defined (DOC)
*
***s/r oda_HT1obs  - Adjoint of LOBSPPP_1obs
*
*
*
*Author  : Luc Fillion - ARMA/EC - 6 Mar 2008.
*Revision: L. Fillion - ARMA/EC - 5 Jun 2009 - Update to v_10_2_2.
*
*    -------------------
*
*     Purpose: 
*
*Arguments
*
*     CDFAM: FAMILY OF OBSSERVATION
*
#endif
      IMPLICIT NONE
      CHARACTER *2 CDFAM
*implicits
#include "taglam4d.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "com1obs.cdk"
#include "comdimo.cdk"
#include "comlun.cdk"
#include "comgem.cdk"
#include "comphy.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
#include "commvog.cdk"
#include "cvcord.cdk"
#include "comnumbr.cdk"
#include "comsim.cdk"
#include "comstate.cdk"
*
      logical llprint
      INTEGER ik,IPB,IPT, IDBURP,  ITYP
      REAL*8 ZRES,ZOER
      real*8 zpresbpt,zpresbpb
      REAL*8 ZWB,ZWT,zcon,zexp,zgamma,ZATV,ZTVG
      REAL*8 ZPT,ZPB,ZDADPS
      real*8 zppobs
      INTEGER IOBS,IPOS,IK,ISTRIDE,IBEGIN,ILAST
      INTEGER J,JF,JDATA
!
!!
      llprint = .true.
!
      ik = mk
      jdata = 1
      ZOER = R1OBSOER ! Obs-error
      zppobs = R1OBSLV*1.e2  !  (Pa)
      ZRES = ROBDATA8(NCMOMA,JDATA)/ZOER
!
      if(llprint) then
        write(nulout,*) 'oda_HT1obs: JDATA,ZRES=',JDATA,ZRES
        write(nulout,*) 'oda_HT1obs: ik=',ik
      endif
!
      if(c1obstp.eq.'UU') then
        IPOS = nouu-1
      else if(c1obstp.eq.'VV') then
        IPOS = novv-1
      else if(c1obstp.eq.'GZ') then
        IPOS = nogz-1
      else if(c1obstp.eq.'TT') then
        IPOS = nott-1
      else if(c1obstp.eq.'LQ') then
        IPOS = noq-1
      else if(c1obstp.eq.'OZ') then
        IPOS = nooz-1
      else if(c1obstp.eq.'TR') then
        IPOS = notr-1
      else if(c1obstp.eq.'ES') then
        IPOS = noes-1
      endif
!
      IOBS = 1
      IPT  = IK + IPOS*NFLEV
      IPB  = IPT+1
      ZPT  = RPPOBS(IK,IOBS)
      ZPB  = RPPOBS(IK+1,IOBS)
      ZWB  = LOG(zppobs/ZPT)/LOG(ZPB/ZPT)
      ZWT  = 1.0D0 - ZWB
      zpresbpt = ((vhybinc(ik) - rptopinc/rprefinc)
     &                     /(1.0-rptopinc/rprefinc))**rcoefinc
      zpresbpb = ((vhybinc(ik+1) - rptopinc/rprefinc)
     &                     /(1.0-rptopinc/rprefinc))**rcoefinc
      ZDADPS   = ( (ZPRESBPT/ZPT)*LOG(zppobs/ZPB)
     &                     -(ZPRESBPB/ZPB)*LOG(zppobs/ZPT) )
     &                     /LOG(ZPB/ZPT)**2
!
      if(LVLNEAR) then
        ZWB = 0.0
        ZWT = 1.0
      endif
!
      GOMOBS(IPB,IOBS) = GOMOBS(IPB,IOBS) + ZWB*ZRES
      GOMOBS(IPT,IOBS) = GOMOBS(IPT,IOBS) + ZWT*ZRES
      GOMPS(1,IOBS)    = GOMPS(1,IOBS)    +
     &                    (GOMOBSG(IPB,IOBS) - GOMOBSG(IPT,IOBS))
     &                    *ZDADPS*ZRES
      if(llprint) then
        write(nulout,*) 'oda_HT1obs: GOMOBS(IPB,IOBS)=',GOMOBS(IPB,IOBS)
        write(nulout,*) 'oda_HT1obs: GOMOBS(IPT,IOBS)=',GOMOBS(IPT,IOBS)
      endif
!
      if(llprint) then
        write(nulout,*) 'oda_HT1obs: GOMOBSG(ik,IOBS)=',GOMOBSG(ik,IOBS)
      endif
!
      return
      end