!-------------------------------------- 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_HTgp 1,2
      use modmask, only : lmaskgp
#if defined (DOC)
*
***s/r  -oda_HTgp Adjoint of TL routine oda_Hgp
*
*
*Author  : S. Macpherson *ARMA December 2004
*    -------------------
**    Purpose: Compute Ht*grad(Jo) for all GPS ZTD observations using
*              adjoint of gpsztdop
*
*Revisions:
*           S. Macpherson - ARMA - March 2009
*            - Rename the subroutine acording to ODA naming convention
*            - Use of NCMOMI as index of adjoint residual variable 
*              instead of NCMOMN
*            - Use of mask to process only assimilated ZTD data
*
*Arguments
*     None
*
*
#endif

      IMPLICIT NONE
*implicits
#include "comlun.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 "comgpsgb.cdk"
*
C
      REAL*8 ZTODEG
      REAL*8 ZLAT
      REAL*8 ZLON
      REAL*8 ZETA(NFLEV)
      REAL*8 ZTT (NFLEV)
      REAL*8 ZHU (NFLEV)
      REAL*8 ZGZ (NFLEV)
      REAL*8 ZTTB (NFLEV)
      REAL*8 ZHUB (NFLEV)
      REAL*8 ZP0
      REAL*8 ZP0B
      REAL*8 ZPT
      REAL*8 ZMT
C
      REAL*8 ZHX, ZLEV
      REAL*8 ZDZ
      REAL*8 ZHXB, ZVAR
C
      REAL*8 DZTT (NFLEV)
      REAL*8 DZHU (NFLEV)
      REAL*8 DZP0
C
      INTEGER JF
      INTEGER IBEGIN  , ILAST
      INTEGER IBEGINOB, ILASTOB, JO
      INTEGER IDATYP, ITYP
      INTEGER IDATA   , IDATEND, JDATA
      INTEGER JL, JK
C
      LOGICAL  ASSIM, LLOK

      INTEGER NH, NH1

C
C     * 1.  Initializations
C     *     ---------------
C
      ZTODEG = 180.0 / RPI
C
C     *    .   1.1  Eta vector
C     *    .        ----------
C
      DO JL = 1, NFLEV
         ZETA(JL) = VLEV(JL)
      ENDDO
C
      write(nulout,fmt='(/,4x,A)') 
     + 'AVGPSZTD- Adjoint Version: GPS ZTD observations'
C
C     Loop over all observation files (all observation types)
C
      DO JF = 1, NFILES
C
C     *  Process only GPS observation files (family = GP)
C
         IF ( CFAMTYP(JF).EQ.'GP' .AND. NBEGINTYP(JF).GT.0 ) THEN
            IBEGIN   = NBEGINTYP(JF)
            ILAST    = NENDTYP  (JF)
            IBEGINOB = MOBDATA(NCMOBS,IBEGIN)
            ILASTOB  = MOBDATA(NCMOBS,ILAST )
C
C     *     Loop over all GPS observations (locations) of the file
C
            DO JO = IBEGINOB, ILASTOB
              DZTT(:) = 0.0
              DZHU(:) = 0.0
              DZP0 = 0.0
C
C             Loop over data in the observations
C
              IDATA   = MOBHDR(NCMRLN,JO)
              IDATEND = MOBHDR(NCMNLV,JO) + IDATA - 1
C
C             Scan for requested ZTD assimilation
C
              NH = 0
              ASSIM = .FALSE.
              DO JDATA= IDATA, IDATEND
                 LLOK = ( lmaskgp(JDATA) )
                 IF ( LLOK ) THEN
                    ASSIM = .TRUE.
                    NH = NH + 1
                 ENDIF
              ENDDO
C
C     *       If ZTD assimilation, apply the AD observation operator
C
              IF (ASSIM) THEN
C
C     *       LR background profile:
C
                 ZLAT = ROBHDR(NCMLAT,JO) * ZTODEG
                 ZLON = ROBHDR(NCMLON,JO) * ZTODEG
                 DO JL = 1, NFLEV
                   ZTTB(JL) = GOMTG(JL,JO)
                   ZTT(JL)  = 0.0
                   ZHUB(JL) = EXP(GOMQG(JL,JO))
                   ZHU(JL)  = 0.0
                   ZGZ(JL)  = GOMGZG(JL,JO)
                 ENDDO
                 ZP0B = GOMPSG(1,JO)
                 ZP0  = 0.0
                 ZPT  = RPPOBS(1,JO)
                 ZMT  = ZGZ(NFLEV)/GRAV
C
C     *       Apply AD of ZTD observation operator to get 
C             Ht*grad(Jo) = Ht*(H'dx - d)/sigma_o^2
C
                 NH1 = 0
                 DO JDATA= IDATA, IDATEND
                    IF ( lmaskgp(JDATA) ) THEN
                       NH1 = NH1 + 1
C                      ROBDATA8(NCMOMI,JDATA) = grad(Jo) 
c                                             = (H'dx - d)/sigma_o^2
                       ZHX = ROBDATA8(NCMOMI,JDATA)
C
C     *                Observation height (m)
                       ZLEV = ROBDATA8(NCMPPP,JDATA)
C     *                Call GP-ZTD adjoint operator: input = ZHX,
c                        output = ZTT,ZHU,ZP0
                       CALL GPSZTDOPAD(ZLAT,ZLON,ZLEV,ZETA,ZTTB,
     +                  ZHUB,ZP0B,ZPT,ZMT,ZGZ,ZHXB,ZTT,ZHU,ZP0,ZHX)
C
                       DZTT(:) = DZTT(:) + ZTT(:)
C                      dJo/dQ ---> dJo/d(lnQ) 
                       DZHU(:) = DZHU(:) + ZHUB(:)*ZHU(:)
                       DZP0 = DZP0 + ZP0
                    ENDIF
                 ENDDO
c
              ENDIF
c
C      *   Store Ht*grad(Jo) in COMMVO
c
              DO JL = 1, NFLEV
                 GOMT(JL,JO) = DZTT(JL)
                 GOMQ(JL,JO) = DZHU(JL)
              ENDDO
              GOMPS(1,JO) = DZP0
C
            ENDDO
C
         ENDIF
C
      ENDDO
C
      RETURN
      END