!-------------------------------------- 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_HTzp 1,1
      use modmask, only : lmaskzp
#if defined (DOC)
*
***s/r AOBSZZZ  - Adjoint of the "vertical" interpolation in z
*                 for profiler data.
*
*
*
*Author  : J. St-James *CMDA/SMC  July 2003
*Revision :
*           S. Pellerin - ARMA - Jan. 2009
*            - Rename the subroutine acording to ODA naming convention
*            - Use of NCMOMI as index of adjoint residual variable
*            - Use of mask to process assimilated observation only
*    -------------------
*
*     Purpose: based on vint3d to build the adjoint of the
*              vertical interpolation for profiler data.
*
*Arguments
*
*     CDFAM: FAMILY OF OBSSERVATION
*
#endif
      IMPLICIT NONE
      CHARACTER *2 CDFAM
*implicits
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comcst.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
#include "commvog.cdk"
*
      INTEGER IPB,IPT, IDBURP,  ITYP
      REAL*8 ZRES,ZOER,ZDA1,ZDA2,ZDENO
      REAL*8 ZWB,ZWT,zcon,zexp,zgamma,ZATV,ZTVG
      REAL*8 ZLEV,ZPT,ZPB,ZDADPS
      INTEGER IOBS,IPOS,IK,ISTRIDE,IBEGIN,ILAST
      INTEGER J,JF,JDATA
      LOGICAL LLOK, LLPRINT
C
      ISTRIDE=2*(NMAXLEN/2) + 1
C
C     Process all data within the domain of the model
C
      DO J=1,ISTRIDE
*vdir nodep
        DO JDATA=J, ndata,ISTRIDE
          IF (lmaskzp(jdata) ) THEN
            IOBS = MOBDATA(NCMOBS,JDATA)
            IPOS = MOBDATA(NCMPOS,JDATA)
            ZRES = ROBDATA8(NCMOMI,JDATA)
            ZLEV = ROBDATA8(NCMPPP,JDATA)
            IK   = ROBDATA(NCMLYR,JDATA)
            IPT  = IK  + IPOS*NFLEV
            IPB  = IPT+1
            ZPT  = GOMGZG(IK,IOBS)/RG
            ZPB  = GOMGZG(IK+1,IOBS)/RG
            ZDENO= ZPT-ZPB
            ZWB  = (ZPT-ZLEV)/ZDENO
            ZWT  = 1.0D0 - ZWB

            ZDA1= (ZLEV-ZPB)/(ZDENO**2)
            ZDA2= (ZPT-ZLEV)/(ZDENO**2)
c            ROBDATA8(NCMOMN,JDATA) = ROBDATA8(NCMOMN,JDATA)
c     &           * ROBDATA8(NCMOMA,JDATA)
C
            GOMGZ(IK+1,IOBS) = GOMGZ(IK+1,IOBS) +
     &           (GOMOBSG(IPB,IOBS)-GOMOBSG(IPT,IOBS))*ZDA2*ZRES/RG
            GOMGZ(IK,IOBS) = GOMGZ(IK,IOBS) +
     &           (GOMOBSG(IPB,IOBS)-GOMOBSG(IPT,IOBS))*ZDA1*ZRES/RG
            GOMOBS(IPB,IOBS) = GOMOBS(IPB,IOBS) + ZWB*ZRES
            GOMOBS(IPT,IOBS) = GOMOBS(IPT,IOBS) + ZWT*ZRES

          ENDIF
        END DO
      END DO
      RETURN
      END