!-------------------------------------- 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_HTgo 1,2
      use modmask, only : lmaskgo
      USE modfgat,only : istepobs,nobs_go,nobtag_go
#if defined (DOC)
*
***s/r AVGOES  - Adjoint GOES processing, i.e. radiative transfer model
*
*
*Author        : N. Wagneur *CMDA/MSC Mai 2001
*
*
*    -------------------
**    Purpose: Update the estimate of GOMOBS, which contain the gradient
*              components at the observation pointsodel and
*
**    Revision:
*              S. Pellerin - ARMA, january 2009
*                - Rename the subroutine acording to ODA naming convention
*                - Use of NCMOMI as index of adjoint residual variable
*          Bin He   - ARMA/MRB   - Oct. 2011,
*                   - 4Dvar optimization.

*
#endif
      IMPLICIT NONE
*implicits
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comlun.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
#include "cparamgoes.cdk"
#include "comjacgoes.cdk"
*
      REAL*8 PTBAD((NFLEV+1)*2,NOBGOES),PTBO(JPNB,NOBGOES)
C
      INTEGER JO, JDATA, IDATA, IDATEND
      INTEGER JK, ICHN

      INTEGER JN
      INTEGER J, I, K
      INTEGER  KK,istep,intobs
C
      if(nobs_go(istepobs).eq.0) return
C
        intobs=0
        if(istepobs>1) then
          do istep=1,istepobs-1
           intobs=intobs+nobs_go(istep)
          enddo
        endif

      DO J=1, nobs_go(istepobs)
       DO I=1, JPNB
         PTBO  (I,J) = 0.D0
       ENDDO
       DO I=1, 2*(NFLEV+1)
         PTBAD (I,J) = 0.D0
       ENDDO
      ENDDO
C
C**   Loop over all satellites specified by user
C
      IF ( nobs_go(istepobs) .GT. 0 ) THEN
         WRITE(NULOUT,FMT=9000)
         WRITE(NULOUT,*)' NGOES = ', nobs_go(istepobs)
      ENDIF
 9000 FORMAT(//,10X,"-AVGOES: computing gradient of GOES"
     S     ," observations")
C
      DO JN = 1, nobs_go(istepobs) 
      
C
C*    .  2.1  Extract general information for this observation point
C     .       ------------------------------------------------------
C
        !JO   = MJOGO(JN)
        JO   = nobtag_go(jn,istepobs)
        IDATA   = MOBHDR(NCMRLN,JO)
        IDATEND = MOBHDR(NCMNLV,JO)+IDATA - 1
C
C*          Loop through data. Extract and store temporarily brightness
c temps.
C
        DO JDATA = IDATA, IDATEND
          IF (lmaskgo(jdata)) then
            ICHN = NINT(ROBDATA8(NCMPPP,JDATA))
c            ROBDATA8(NCMOMN,JDATA) = ROBDATA8(NCMOMN,JDATA)
c     &           * ROBDATA8(NCMOMA,JDATA)
            MOBDATA(NCMXTR,JDATA) = 0
            PTBO (ICHN,JN) = ROBDATA8(NCMOMI,JDATA)
          ENDIF
        enddo
C
      enddo
C
C
***************************************************************
C
C*    .  2.3 Adjoint of radiative transfer model
C     .      -----------------------------------
C
C*          TBAD = (HX)T*(NCMOMA)/SIGMA
C           avec dans NCMOMA = (HX-Z)/SIGMA calcule dans lvgoes
C
      DO K = 1, nobs_go(istepobs)
        KK=K+intobs
        DO J = 1, 2*(NFLEV+1)
          DO I = 1, JPNB
            PTBAD(J,K)=PTBAD(J,K)+(HJACMSCFAST(KK,J,I)*PTBO(I,K))
          ENDDO
        ENDDO
      ENDDO
C
      DO JN = 1, nobs_go(istepobs)
        JO = nobtag_go(jn,istepobs)
        DO JK = 1, NFLEV
          GOMT(JK,JO) = PTBAD(JK,JN)
          GOMQ(JK,JO) = PTBAD(NFLEV+1+JK,JN)
        ENDDO
      ENDDO
C
      DO JN = 1, nobs_go(istepobs) 
        JO = nobtag_go(jn,istepobs) 
        GOMTGR(1,JO)       = PTBAD(NFLEV+1,JN)
        GOMPS (1,JO)       = PTBAD(2*(NFLEV+1),JN)
      ENDDO
C
C
      RETURN
      END