SUBROUTINE DOBSGPSRO(PJO) 1
#if defined (DOC)
*
***s/r DOBSGPSRO - Computation of Jo and the residuals to the GPSRO observations
*
*
*Author  : J. M. Aparicio Jan 2004
*Revision:
*          Y.J. Rochon ARQX, March 2010
*            - Addition of obs simulation option with LSIMOB=.TRUE.
*    -------------------
**    Purpose:
*
*Arguments
*     PJO: total value of Jo for GPSRO
*
#endif
      use modgps04profile
      use modgps05refstruct
      use modgps06gravity
      use modgps07geostruct
      use modgps08refop
      IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcva.cdk"
#include "comgem.cdk"
#include "comdimo.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comct0.cdk"
#include "comnumbr.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
#include "commvohr.cdk"
#include "cvcord.cdk"
#include "comphy.cdk"
#include "comvarqc.cdk"
*
      REAL*8 PJO, PJOB, PJOM, PJOX, PJO1
C
      REAL*8 ZTODEG
      REAL*8 ZLAT, Lat
      REAL*8 ZLON, Lon
      REAL*8 ZETA(JPNFLEV)
      REAL*8 ZTT (JPNFLEV)
      REAL*8 ZHU (JPNFLEV)
      REAL*8 ZGZ (JPNFLEV)
      REAL*8 ZP0
      REAL*8 ZPT, ZPR, ZCF
      REAL*8 ZMT
      REAL*8 DH,DDH
      REAL*8 HNH1
C
      REAL*8 ZOBS, ZMHX, ZOER, ZINC
C
      INTEGER JF
      INTEGER IBEGIN  , ILAST
      INTEGER IBEGINOB, ILASTOB, JO, JD
      INTEGER IDATYP
      INTEGER IDATA   , IDATEND, JDATA
      INTEGER JL, JH, NQCVAR, NGPSLEV
C
      LOGICAL  ASSIM

      INTEGER NH, NH1
      TYPE(GPSPROFILE)           :: PRF 
      REAL(DP)     , ALLOCATABLE :: H   (:)
      TYPE(GPSDIFF), ALLOCATABLE :: RSTV(:)

      WRITE(NULOUT,*)'ENTER DOBSGPSRO'
C
C     * 1.  Initializations
C     *     ---------------
C
      ZTODEG = 180.0 / RPI
C
C     *    .   1.1  Eta vector
C     *    .        ----------
C
      NGPSLEV=NLEVTRL
      DO JL = 1, NLEVTRL
         ZETA(JL) = VLEVHR(JL)
      ENDDO
C
C     * QC VAR
C
      IF (LVARQC) THEN
         NQCVAR = 1
      ELSE
         NQCVAR = 0
      ENDIF
C
C     Loop over all files
C
      DO JF = 1, NFILES
         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
            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
                     IF ( MOBDATA(NCMASS,JDATA).EQ.1 ) THEN
                        ASSIM = .TRUE.
                        NH = NH + 1
                     ENDIF
                  ENDDO
C
C     *           If assimilations are requested, apply the observation 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, NLEVTRL
C
C     *                 Profile x
C
                        ZTT(JL) = GOMTHR (JL,JO)-273.15
                        ZHU(JL) = GOMQHR (JL,JO)
                        ZGZ(JL) = GOMGZHR(JL,JO)
                     ENDDO
                     ZP0 =  GOMPSHR(1,JO)
                     ZPT = RPPOBSHR(1,JO)
                     ZMT = ZGZ(NLEVTRL)/RG
                     ZMT = gpsgeopotential(Lat, ZMT)/RG
                     ZPR = rprefinc
                     ZCF = rcoefinc
C     
C     *              GPS profile structure:
C
                     CALL GPSSTRUCT1H(NGPSLEV,ZLAT,ZLON,ZETA,
     +                    ZTT,ZHU,ZP0,ZMT,ZPT,ZPR,ZCF,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
                        IF ( MOBDATA(NCMASS,JDATA).EQ.1 ) 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(x)-Y)/S operation
C
                     NH1 = 0
                     PJOB = 0._dp
                     DO JDATA= IDATA, IDATEND
                        IF ( MOBDATA(NCMASS,JDATA).EQ.1 ) THEN
                           NH1 = NH1 + 1
C
C     *                    Observation operator H(x)
C
                           ZMHX = RSTV(NH1)%VAR
C
C     *                    Observation value    Y
C
                           ZOBS = ROBDATA8(NCMVAR,JDATA)
C
C     *                    Observation error    S
C
                           ZOER = ROBDATA8(NCMOER,JDATA)
C
C     *                    Normalized increment
C
                           ZINC = (ZMHX - ZOBS) / ZOER

                           IF (.NOT.LSIMOB) THEN
                              ROBDATA8(NCMOMA,JDATA) = ZINC
                              ROBDATA8(NCMOMN,JDATA) = ZINC
                              ROBDATA8(NCMOMI,JDATA) = ZINC
C                           
C                             OMF Tested criteria:
C
                              PJO1 = 0.5_dp * ZINC * ZINC
                           ELSE
                              ROBDATA8(NCMOMA,JDATA) = 0.0
                              ROBDATA8(NCMOMN,JDATA) = 0.0
                              ROBDATA8(NCMOMI,JDATA) = 0.0
                              ROBDATA8(NCMVAR,JDATA) = ZMHX
                              PJO1 =0._dp
                           END IF
C
C     *                    Total (PJO) and per profile (PJOB) cumulatives:
C
                           PJO = PJO + PJO1
                           PJOB= PJOB+ PJO1
C
c                           IF (JO.EQ.IBEGINOB) THEN
c                              WRITE(NULOUT,
c     +                             '(A9,i5,2f7.2,f8.0,3f9.4,15f12.4)')
c     +                             'DOBSGPSRO',
c     +                             JO,ZLAT,ZLON,
c     +                             h(nh1),ZOBS,ZOER,ZMHX,ZINC,
c     +                             PJO,PRF%GST(NGPSLEV)%Var
C     *                       DO JD=1,NGPSCVARS
C     *                          WRITE(NULOUT,*)'DOBSGPSROB',
C     * +                           JD,ZMHX,RSTV(NH1)%DVAR(JD)
C     *                       ENDDO
c                           ENDIF
                        ENDIF
                     ENDDO
                     DEALLOCATE( RSTV )
                     DEALLOCATE( H    )
c                     WRITE(NULOUT,
c     +                    '(A9,i5,2f7.2,f18.10,3f9.4,15f12.4)')
c     +                    'GPSRO_JO',JO,ZLAT,ZLON,PJOB
                  ENDIF
               ENDIF
            ENDDO

         ENDIF
      ENDDO
      WRITE(NULOUT,*)'EXIT DOBSGPSRO'
      RETURN
      END