!-------------------------------------- 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_H1obs 1
#if defined (DOC)
*
***s/r oda_H1obs  - 
*
*
*Author  : L. Fillion - ARMA/EC - 5 Jun 2009.
*Revision:
*
**    Purpose:  - 1Obs computation of Forward model obs.
*
*
*Arguments
*
#endif
      IMPLICIT NONE
      REAL*8 PJO
      CHARACTER *2 CDFAM
*implicits
#include "taglam4d.cdk"
#include "comlun.cdk"
#include "com1obs.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comgem.cdk"
#include "comcst.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 "comstate.cdk"
#include "comsim.cdk"
*
*
      logical llprint
      INTEGER IPB,IPT,IDBURP
      INTEGER IOBS,IPOS,IBEGIN,ILAST,ILASTOB,IBEGINOB,IDATEND,NQCVAR
      INTEGER J,JDATA,IDATA,ITYP,ISTYP,JJ,JO
      integer imin,ik,jlev
      REAL*8 ZVAR,ZOER,ZDADPS,ZCON,ZINC,ZPHI,ZJON,ZGAMI,ZSLEV,ZQCARG
      REAL*8 ZWB,ZWT, ZEXP, ZGAMMA,ZLTV,ZTVG,ZPPOST
      REAL*8 ZPT,ZPB,ZLAT,ZLON,ZTORAD
      real*8 zpresbpt,zpresbpb
      real*8 zppobs,zmin,zdiff

      REAL*8 DLSUM
!
!!
      llprint = .true.
      DLSUM=0.
!
! TT
      jdata = 1
      ZVAR = R1OBSINO  ! innovation 
      ZOER = R1OBSOER ! Obs-error
      zppobs = R1OBSLV*1.e2  !  (Pa)
!
      ik = mk
      if(llprint) write(nulout,*) 'oda_H1obs: R1OBSLV (mb) = ',R1OBSLV
      if(llprint) write(nulout,*) 'oda_H1obs: Obs. Level = ',ik
      if(llprint) write(nulout,*) 'oda_H1obs: R1OBSINO=',R1OBSINO
      if(llprint) write(nulout,*) 'oda_H1obs: R1OBSOER=',R1OBSOER
!
      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
      write(nulout,*) 'oda_H1obs: IPOS = ',IPOS
!
!*    Computation of (HX - Z)/SIGMA
!     -----------------------------
!
      IOBS = 1
      IPT  = IK + IPOS*NFLEV
      IPB  = IPT+1
      write(nulout,*) 'oda_H1obs: IPB = ',IPB
      write(nulout,*) 'oda_H1obs: IPT = ',IPT
      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
!
      write(nulout,*) 'oda_H1obs: LVLNEAR = ',LVLNEAR
      if(LVLNEAR) then
        ZWB = 0.0
        ZWT = 1.0
      endif
!
      if(llprint) then
        write(nulout,*) 'oda_H1obs: ZPT = ',ZPT
        write(nulout,*) 'oda_H1obs: ZPB = ',ZPB
        write(nulout,*) 'oda_H1obs: ZWB = ',ZWB
        write(nulout,*) 'oda_H1obs: ZWT = ',ZWT
        write(nulout,*) 'oda_H1obs: vhybinc(ik) = ',vhybinc(ik)
        write(nulout,*) 'oda_H1obs: vhybinc(ik+1) = ',vhybinc(ik+1)
        write(nulout,*) 'oda_H1obs: rptopinc = ',rptopinc
        write(nulout,*) 'oda_H1obs: rprefinc = ',rprefinc
        write(nulout,*) 'oda_H1obs: zpresbpt = ',zpresbpt
        write(nulout,*) 'oda_H1obs: zpresbpb = ',zpresbpb
        write(nulout,*) 'oda_H1obs: zdadps = ',zdadps
      endif
!
      ROBDATA8(NCMOMA,JDATA) =
     &                   ZWB*GOMOBS(IPB,IOBS) + ZWT*GOMOBS(IPT,IOBS)+
     &                   (GOMOBSG(IPB,IOBS)-GOMOBSG(IPT,IOBS))*
     &                   ZDADPS*GOMPS(1,IOBS)
      ROBDATA8(NCMOMN,JDATA) = ROBDATA8(NCMOMA,JDATA)
      ROBDATA8(NCMOMI,JDATA) = ROBDATA8(NCMOMA,JDATA)
!
      if(llprint) then
       write(nulout,*) 'oda_H1obs: ROBDATA8(NCMOMA,1)=',ROBDATA8(NCMOMA,1)
      endif
!
      RETURN
      END