SUBROUTINE oda_Hro
#if defined (DOC)
*
* Purpose: Compute simulated GPSRO observations from profiled model
*          increments.
*          It returns Hdx in ROBDATA8(NCMOMA,*)
*Author  : J. M. Aparicio Jan 2004
*Revision : S. Pellerin, ARMA, August 2008
*              . OpenMP parallel region
*           S. Pellerin ARMA, January 2009
*            - Rename the subroutine acording to ODA naming convention
*            - Computation of Hdx instead of Jo=sum([Hdx-d]/sigma)
*           Y. Yang Feb. 2010
*            - added comnumbr.cdk due to dependencies on JPNBRELEM in cvcord.cdk
*
#endif
      use modgps04profile
      use modgps06gravity
      use modgps08refop
      IMPLICIT NONE

#include "pardim.cdk"
#include "comdim.cdk"
#include "comgem.cdk"
#include "comdimo.cdk"
#include "comcst.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
#include "commvog.cdk"
#include "comnumbr.cdk"
#include "cvcord.cdk"
*
C
      REAL*8 ZTODEG
      REAL*8 ZLAT, Lat
      REAL*8 ZLON, Lon
      REAL*8 ZETA(JPNFLEV)
      REAL*8 BTT(JPNFLEV)
      REAL*8 BHU(JPNFLEV)
      REAL*8 BGZ(JPNFLEV)
      REAL*8 BP0
      REAL*8 BPT, BPR, BCF
      REAL*8 BMT
      REAL*8 DH
      REAL*8 AVG1,AVG2,BIAS,STD,RMS
      REAL*8 HNH1
C
      REAL*8 ZOBS, ZMHX, ZOER, ZOBI, ZMHXL
      REAL*8 JAC(ngpscvmx)
      REAL*8 DX (ngpscvmx)
C
      INTEGER JF
      INTEGER IBEGIN  , ILAST
      INTEGER IBEGINOB, ILASTOB, JO
      INTEGER IDATYP
      INTEGER IDATA   , IDATEND, JDATA
      INTEGER JL, JV, JH, NGPSLEV
C
      LOGICAL  ASSIM, LUSE

      INTEGER NH, NH1, index
      TYPE(GPSPROFILE)           :: PRF
      REAL(DP)     , ALLOCATABLE :: H   (:)
      TYPE(GPSDIFF), ALLOCATABLE :: RSTV(:)
C
C     * 1.  Initializations
C     *     ---------------
C
      ZTODEG = 180.0 / RPI
C
C     *     Eta vector:
C
      NGPSLEV=NFLEV
      DO JL = 1, NFLEV
        ZETA(JL) = VLEV(JL)
      ENDDO
C
C
C     Loop over all files
C
      DO JF = 1, NFILES
C
C     *  Look only files of type Radio Occultation (RO)
C
        IF ( CFAMTYP(JF).EQ.'RO' .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 observations of the file
C
C$omp parallel do default(shared)
C$omp+private(idatyp,idata,idatend,assim,nh)
C$omp+private(jdata,luse,lat,lon,zlat,zlon,jl,btt)
C$omp+private(bhu,bgz,bp0,bpt,bmt,bpr,bcf,dx,prf)
C$omp+private(h,rstv,nh1,hnh1,zobi)
C$omp+private(jac,zmhxl,jv)
          DO JO = IBEGINOB, ILASTOB
C
C     *        Process only refractivity data (codtyp 169)
C
            IDATYP = MOD(MOBHDR(NCMITY,JO),1000)
            IF ( IDATYP .EQ. 169 ) THEN
C
C                 Loops over data in the observation
C
              IDATA   = MOBHDR(NCMRLN,JO)
              IDATEND = MOBHDR(NCMNLV,JO) + IDATA - 1
              ASSIM = .FALSE.
C
C                 Scan for requested assimilations, and count them
C
              NH = 0
              DO JDATA= IDATA, IDATEND
                LUSE=( MOBDATA(NCMASS,JDATA).EQ.1 )
                IF ( LUSE ) THEN
                  ASSIM = .TRUE.
                  NH = NH + 1
                ENDIF
              ENDDO
C
C     *           If assimilations are requested, apply the observation
c operator
C
              IF (ASSIM) THEN
C
C     *              Profile at the observation location:
C
                Lat  = ROBHDR(NCMLAT,JO)
                Lon  = ROBHDR(NCMLON,JO)
                ZLAT = Lat * ZTODEG
                ZLON = Lon * ZTODEG
                DO JL = 1, NFLEV
C
C     *                 Profile x_b
C
                  BTT(JL) = GOMTG (JL,JO) - 273.15
                  BHU(JL) = GOMQG (JL,JO)
                  BGZ(JL) = GOMGZG(JL,JO)
                ENDDO
                BP0 = GOMPSG(1,JO)
                BPT = RPPOBS(1,JO)
                BMT = BGZ(NFLEV)/RG
                BMT = gpsgeopotential(Lat, BMT)/RG
                BPR = rprefinc
                BCF = rcoefinc
C
C     *              Local vector state
C
                DO JL = 1, NFLEV
                  DX (      JL) = GOMT (JL,JO)
                  DX (NFLEV+JL) = GOMQ (JL,JO)
                ENDDO
                DX (2*NFLEV+1)   = GOMPS(1 ,JO)
C
C     *              GPS profile structure:
C
                CALL GPSSTRUCT1H(NGPSLEV,ZLAT,ZLON,ZETA,
     +               BTT,BHU,BP0,BMT,BPT,BPR,BCF,PRF)
                call gpsgeo(prf)
C
C     *              Prepare the vector of all the observations:
C
                ALLOCATE( H    (NH) )
                ALLOCATE( RSTV (NH) )
                NH1 = 0
                DO JDATA= IDATA, IDATEND
                  LUSE=( MOBDATA(NCMASS,JDATA).EQ.1 )
                  IF ( LUSE ) THEN
                    NH1 = NH1 + 1
                    HNH1  = ROBDATA8(NCMPPP,JDATA)
                    H(NH1)= gpsgeopotential(Lat,HNH1)/9.80616
                  ENDIF
                ENDDO
C
C     *              Apply the observation operator:
C
                CALL GPSREFOPV(H, PRF, RSTV)
C
C     *              Perform the (H(xb)DX-Y')/S operation
C
                NH1 = 0
                DO JDATA= IDATA, IDATEND
                  LUSE=( MOBDATA(NCMASS,JDATA).EQ.1 )
                  IF ( LUSE ) THEN
                    NH1 = NH1 + 1
C
C     *                    Observation jacobian
C
                    JAC = RSTV(NH1)%DVAR
C
C     *                    Evaluate H(xb)DX
C
                    ZMHXL = 0._DP
                    DO JV = 1, 2*PRF%NGPSLEV+1
                      ZMHXL = ZMHXL + JAC(JV) * DX(JV)
                    ENDDO
C
C     *                    Normalized increment
C
C                          O-F Tested criteria:
C
C     *                    Accumulate observation cost function (per
c profile):
C
C     *                    Store in CMA
C
                    ROBDATA8(NCMOMA,JDATA) = ZMHXL

                  ENDIF
                ENDDO
                DEALLOCATE( RSTV )
                DEALLOCATE( H    )
              ENDIF
            ENDIF
C
C     *        Accumulate the observation cost function (all GPSRO):
C
          ENDDO
C$omp end parallel do
        ENDIF
      ENDDO
      RETURN
      END