SUBROUTINE oda_qcv use modmask, only : lmask,lmaskgo,lmaskro IMPLICIT NONE * *Purpose : 1) Modify Jo [ROBDATA8(NCMOMI,*)] according to * Andersson and Jarvinen 1999, Variational quality control, * Q.J.R., 125, pp. 697-722. * 2) Save the values of (1-Wqc) in ROBDATA8(NCMOMN,*) * for gradient factorization and postalt flag criterion. * *Author : S. Pellerin, ARMA, January 2009 * Generalisation of QCVAR originally embeded in observation * operators from P. Koclas, J. Halle and J. St-James * *Revisions : * #include "comdimo.cdk"
#include "comdim.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comnumbr.cdk"
#include "comstate.cdk"
* integer :: jdata,istyp,jj,jo,ityp,idata real*8 :: zgami,zjon,zqcarg,zppost,zlev,zslev logical :: lluv,llmask(ndata) C llmask = lmask .neqv. lmaskgo ! Exclusion of GOES QCVAR llmask = llmask .neqv. lmaskro ! Exclusion of GPSRO QCVAR DO JDATA=1,ndata IF (llmask(jdata)) THEN jo = MOBDATA(NCMOBS,jdata) idata = MOBHDR(NCMRLN,JO) ZLEV = ROBDATA8(NCMPPP,JDATA) zgami = robdata(ncmpob,jdata) ITYP = MOBDATA(NCMVNM,JDATA) LLUV = ((ITYP .EQ. NVNUMB(1) .OR. ITYP .EQ. NEUS) .AND. & NMVOEXIST(NOUU) .EQ. 1) .OR. ((ITYP .EQ. NVNUMB(2) .OR. & ITYP .EQ. NEVS).AND. NMVOEXIST(NOVV) .EQ. 1) IF (LLUV) THEN IF (ITYP .EQ. NVNUMB(1) .OR. ITYP .EQ. NEUS)THEN C C In order to calculate the contribution to Jo from a wind, the o-a C must be available for both u and v components. Hence, loop over only C data for which o-a has already been calculated C DO JJ=IDATA, JDATA ISTYP = MOBDATA(NCMVNM,JJ) ZSLEV = ROBDATA8(NCMPPP,JJ) IF ((ISTYP .EQ. NVNUMB(2) 1 .OR. ISTYP .EQ. NEVS) .AND. 2 ZSLEV .EQ. ZLEV) THEN ZJON=ROBDATA8(NCMOMI,JDATA)+ & ROBDATA8(NCMOMI,JJ) ZQCARG = ZGAMI + EXP(-1.0*ZJON) ZPPOST = ZGAMI/ZQCARG C C Store the value of o-a multiplied by one minus the posterior C probability of gross error (needed for the adjoint calculations) C ROBDATA8(NCMOMN,JDATA) = ZPPOST ROBDATA8(NCMOMN,JJ) = ZPPOST ROBDATA8(NCMOMI,JDATA)=-LOG(ZQCARG/(ZGAMI+1.)) & /2. ROBDATA8(NCMOMI,JJ) = -LOG(ZQCARG/(ZGAMI+1.)) & /2. C C Contribution of both u and v added to the cost function at the C same time (see tech. note by Andersson and Jarvinen) C ENDIF ENDDO ELSE DO JJ=IDATA, JDATA ISTYP = MOBDATA(NCMVNM,JJ) ZSLEV = ROBDATA8(NCMPPP,JJ) IF ((ISTYP .EQ. NVNUMB(1) .OR. 1 ISTYP .EQ. NEUS) .AND. 2 ZSLEV .EQ. ZLEV) THEN ZJON=ROBDATA8(NCMOMI,JDATA)+ & ROBDATA8(NCMOMI,JJ) ZQCARG = ZGAMI + EXP(-1.0*ZJON) ZPPOST = ZGAMI/ZQCARG ROBDATA8(NCMOMN,JDATA) = ZPPOST ROBDATA8(NCMOMN,JJ) = ZPPOST ROBDATA8(NCMOMI,JDATA)=-LOG(ZQCARG/(ZGAMI+1.)) & /2. ROBDATA8(NCMOMI,JJ) = -LOG(ZQCARG/(ZGAMI+1.)) & /2. ENDIF enddo endif else zjon = robdata8(ncmomi,jdata) zqcarg = zgami + exp(-1.0*zjon) zppost = zgami/zqcarg robdata8(ncmomn,jdata) = zppost ROBDATA8(NCMOMI,JDATA)= - log(zqcarg/(zgami+1.)) endif endif enddo RETURN END