!-------------------------------------- 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 DOBSGPSGB(PJO) 1,1
#if defined (DOC)
*
***s/r DOBSGPSGB - Computation of Jo and the residuals to the GPSGB observations
*
*
*Author : S. Macpherson *ARMA March 2004
* -------------------
** Purpose: Compute Jo and norm. innovations for all GPS ZTD observations
*
*Arguments
* PJO: (returned) total value of Jo for GPSGB (on input = 0.0)
*
*Revision:
* S. Macpherson *ARMA December 2008
* -- modified continuation of first/single site data printout statement
* (was not printing anything)
*
* Note: JPNFLEV=100 = maximum number of levels (set in pardim.cdk)
* NLEVTRL = actual number of background levels (HR)
* NFLEV = number of LR analysis levels (set in namelist)
#endif
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 "comgpsgb.cdk"
*
REAL*8 PJO
C
REAL*8 ZTODEG
REAL*8 ZLAT
REAL*8 ZLON
REAL*8 ZETA(NLEVTRL)
REAL*8 ZTT (NLEVTRL)
REAL*8 ZHU (NLEVTRL)
REAL*8 ZGZ (NLEVTRL)
REAL*8 ZP0
REAL*8 ZPT
REAL*8 ZMT
C
REAL*8 ZOBS, ZOER, ZINC, ZHX, ZLEV
REAL*8 ZDZ
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, NLEVTRL
ZETA(JL) = VLEVHR(JL)
ENDDO
C
C Loop over all observation files (all observation types)
C
WRITE(NULOUT, *) ' '
WRITE(NULOUT, *) ' '
WRITE(NULOUT,'(A11,A9,3A8,A9,4A8,A10)')
+ 'DOBSGPSGB','CSTNID','ZLAT','ZLON',
+ 'ZLEV','ZDZ','ZOBS','ZOER','ZHX','O-P','PJO'
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
C
C * . Process only zenith delay data (codtyp 189)
C
IDATYP = MOD(MOBHDR(NCMITY,JO),1000)
IF ( IDATYP .EQ. 189 ) THEN
C
C Loops over data in the observations
C
IDATA = MOBHDR(NCMRLN,JO)
IDATEND = MOBHDR(NCMNLV,JO) + IDATA - 1
ASSIM = .FALSE.
C
C Scan for requested assimilations, and count them.
C Get station height ZLEV
C
NH = 0
DO JDATA= IDATA, IDATEND
ITYP = MOBDATA(NCMVNM,JDATA)
LLOK = ( (ITYP .EQ. NEZD) .AND.
& (MOBDATA(NCMASS,JDATA) .EQ. 1) )
IF ( LLOK ) THEN
ZLEV = ROBDATA8(NCMPPP,JDATA)
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 x :
C
ZLAT = ROBHDR(NCMLAT,JO) * ZTODEG
ZLON = ROBHDR(NCMLON,JO) * ZTODEG
DO JL = 1, NLEVTRL
ZTT(JL) = GOMTHR(JL,JO)
ZHU(JL) = EXP(GOMQHR(JL,JO))
ZGZ(JL) = GOMGZHR(JL,JO)
ENDDO
ZP0 = GOMPSHR(1,JO)
ZPT = RPPOBSHR(1,JO)
ZMT = ZGZ(NLEVTRL)/GRAV
C
C * Apply the ZTD observation operator ZHX = H(x)
C
C
ZHX = 0.0
ZDZ = ZLEV - ZMT
CALL GPSZTDOP(ZLAT,ZLON,ZLEV,ZETA,ZTT,ZHU,ZP0,ZPT,
+ ZMT,ZGZ,ZHX)
C
C * Perform the (H(x)-Y)/SDERR operation
C
NH1 = 0
DO JDATA= IDATA, IDATEND
ITYP = MOBDATA(NCMVNM,JDATA)
IF ( MOBDATA(NCMASS,JDATA) .EQ. 1 .AND.
+ ITYP .EQ. NEZD ) THEN
NH1 = NH1 + 1
C
C * Observation value Y
C
ZOBS = ROBDATA8(NCMVAR,JDATA)
C
C * Observation error SDERR
C
ZOER = ROBDATA8(NCMOER,JDATA)
C
C * Observation height (m)
C
ZLEV = ROBDATA8(NCMPPP,JDATA)
C
C * Normalized increment
C
ZINC = (ZHX - ZOBS) / ZOER
ROBDATA8(NCMOMA,JDATA) = ZINC
C
C * Contribution to the cost function
C
PJO = PJO + ZINC * ZINC
C
C * Print data for first observation or single site
IF (L1GPSOBS) THEN
IF (CSTNID(JO) .EQ. CGPSSTN) THEN
WRITE(NULOUT,
+ '(A11,A9,3(1x,f7.2),1x,f8.2,4(1x,f7.5),1x,f9.2)')
+ 'DOBSGPSGB: ',CSTNID(JO),ZLAT,ZLON,ZLEV,ZDZ,
+ ZOBS,ZOER/YZDERRWGT,ZHX,-ZINC*ZOER,PJO
ENDIF
ELSE
IF (JO .EQ. IBEGINOB .AND. NH1 .EQ. 1) THEN
WRITE(NULOUT,
+ '(A11,A9,3(1x,f7.2),1x,f8.2,4(1x,f7.5),1x,f9.2)')
+ 'DOBSGPSGB: ',CSTNID(JO),ZLAT,ZLON,ZLEV,ZDZ,
+ ZOBS,ZOER/YZDERRWGT,ZHX,-ZINC*ZOER,PJO
ENDIF
ENDIF
C
ENDIF
ENDDO
ENDIF
ENDIF
ENDDO
ENDIF
ENDDO
C
WRITE(NULOUT, *) ' '
RETURN
END