!-------------------------------------- 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 SETERR 1,10
#if defined (DOC)
*
*s/r SETERR -SET OBSERVATION ERROR
*
*Author : P. Koclas *CMC/AES February 1995
*Revision: C. Charette - ARMA/AES - Jul 95.
* - Correct obs err for asdar,satob,airep.
* Add obs err for synop automatic, acars
*Revision: P. Koclas *CMC/AES - August 95.
* -ALLOW HUMSAT FAMILY
* P. Koclas *CMC/AES - April 96
* -contents of comstdev now in comstato
* -initialize NCMOEC index in ROBDATA
* -More legible output to NULOUT file
* S. Pellerin *ARMA/AES - Sept 97
* -Introduction of type OZ
* C. Charette *ARMA/AES - Sept 98
* -Pressures in Pascal
* J. Halle *CMDA/AES - Oct 1999
* -added TOVS observation errors
* C. Charette *ARMA/AES - Jun 2000
* -added obs error for surface elements
* P. Koclas *CMC/CMDA September 2000
* -vertical interpolation of upper-air obs error
* J. Halle *CMDA/SMC - Dec 2000
* -TOVS lvel 1B data
* JM Belanger *CMDA/SMC - june 2001
* -32 bits conversion
* R. Sarrazin *CMDA/CMC - July 2001
* -include idburp 188
* C. Charette *ARMA/AES - Nov 2001
* -call abort3d if obserr variance negative
* J. Halle *CMDA/SMC - Ma 2002
* -adapt to RTTOV7
* . N. Wagneur *MSC/CMC June 2002
* -added GOES observation errors
* J. St-James *CMDA/SMC - July 2003
* -add Profiler observation error
* JM Belanger *CMDA/SMC - dec 2003
* -Define Quikscat observation errors
* . R. Sarrazin *CMC March 2004.
* -satwinds errors in 10 layers
* . D. Anselmo *MSC/ARMA October 2004.
* -add artificial observation error for atmospheric
* and surface ln q values added to CMA.
* J.M. Aparicio *ARMA/MSC* October 2006
* - Adapt for GPSRO
* R. Sarrazin, Nov 2006
* -add condition to set AI family ES error
* S. Macpherson *ARMA/MRD September 2007
* -added ground-based GPS observation errors
*
** Purpose:
* -set observation errors for each data
* in CMA.
*
*Arguments
* none
*
#endif
IMPLICIT NONE
*implicits
*
#include "comlun.cdk"
#include "comcst.cdk"
#include "cvcord.cdk"
#include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comstato.cdk"
#include "partov.cdk"
#include "comtov.cdk"
#include "comtovst.cdk"
#include "cparamgoes.cdk"
#include "comgoes.cdk"
#include "comgoesst.cdk"
#include "comnumbr.cdk"
#include "comgpsgb.cdk"
*
C
C NOTE: YSFERRWGT IN COMGPSGB.CDK (FROM NML FILE) IS USED HERE FOR ERROR WEIGHTING
C OF TIME SERIES (FGAT) GPS MET OBSERVATIONS PS, TS, DPDS (ORIGINALLY DESIGNED
C FOR SHIFTPROF OPTION (NOT USED -- LSHIFT = .FALSE. IN NML)
C-----------------------------------------------------------------------
C
INTEGER JN,JDATA,JJO
INTEGER ITYP,IFLG,IASS,IDATYP,ILEM,ITY,ilyr
INTEGER IDATA,IDATEND,IFIND,IDBURP,ITECH,ISAT,ILVL
INTEGER ILAT1,ILAT2
INTEGER ILANSEA,ISRCHEQ,INDXREG,INDXCLD,INDXM
INTEGER INDXSAT,ICHN,ISATNO
INTEGER ICHN,IPLATF,INSTR,IPLATFORM,INSTRUM
REAL*8 DELTAP, DELTAPMIN
REAL*8 ZLAT, ZLON, ZFACTOR, ZTORAD, H, NAPP, NERR
REAL*8 ZLEV,ZFACT,ZLVL,ZCONGZ,ZVAL,zpb,zpt,zwb,zwt,zcof1,zcof2
logical llinterp, LLBAD
CHARACTER*2 SENSORTYPE
C
C FOR GB-GPS OBSERVATIONS
C ==========================================================================
LOGICAL LLCZTDE, LLFER, LLFZTDE, LLZTD, LLRZTDE
REAL*8 ZTDERR, ZZTD, ZMINZDE
INTEGER IZTDJ
C
C REGRESSION EQUATION CONSTANTS FOR ZTD ERROR (SD(O-P)) -- CUBIC FIT
C - FROM OCTOBER 2004 SD(O-P) AND MEAN ZTD STATISTICS OF NOAA/FSL SITES
C ---------------------------------------------------------------------------
C
REAL*8 Z3, Z2, Z1, ZC
DATA Z3, Z2, Z1, ZC /160.38, -1009.1, 2115.4, -1464.6/
C
C ZZDERMIN = MIN ZTD OER VALUE (M), ZZFERREJ = MAX FERR VALUE (M) FOR REJECTION
C ZTDERFAC = MULTIPLICATION FACTOR FOR FORMAL ZTD MEASUREMENT ERROR
C ZOPEFAC = FRACTION OF REGRESSION EQUATION SD(O-P) TO USE AS ZTD OBSERVATION ERROR
C ----------------------------------------------------------------------------------
C
REAL*8 ZZDERMIN, ZZFERREJ, ZTDERFAC, ZOPEFAC
DATA ZZDERMIN /0.012D0/
DATA ZZFERREJ /0.015D0/
DATA ZTDERFAC /3.0D0/
DATA ZOPEFAC /1.0D0/
C ==========================================================================
C
221 CONTINUE
C
WRITE(NULOUT,'(10X,"SUBROUTINE SETERR")')
WRITE(NULOUT,'(10X,"-----------------",/)')
WRITE(NULOUT,'(10X,"***********************************")')
WRITE(NULOUT,'(10X," SET OBSERVATION ERRORS:",/)')
WRITE(NULOUT,'(10X,"***********************************")')
C
LLCZTDE = .FALSE.
LLRZTDE = .FALSE.
LLFZTDE = .FALSE.
IF (YZTDERR .LT. 0.0) THEN
LLFZTDE = .TRUE.
ELSE IF (YZTDERR .GT. 0.0) THEN
LLCZTDE = .TRUE.
ELSE
LLRZTDE = .TRUE.
ENDIF
C
C
C SET STANDARD DEVIATION ERRORS FOR EACH DATA FAMILY
C ---------------------------------------------------
C
100 CONTINUE
ZFACT=VCONV
ZCONGZ=10.D0*RG
ZTORAD=1.D0/(RPI/180.D0)
LLBAD = .FALSE.
DO JJO = 1, NOBTOT
IDATA = MOBHDR(NCMRLN,JJO)
IDATEND = MOBHDR(NCMNLV,JJO) + IDATA - 1
IDATYP = MOBHDR(NCMOTP,JJO)
ILANSEA = MOBHDR(NCMOFL,JJO)
ZLAT = ROBHDR(NCMLAT,JJO)
ZLON = ROBHDR(NCMLON,JJO)
ITY = MOBHDR(NCMITY,JJO)
IDBURP = MOD(ITY,1000)
ITY = ITY/1000
IPLATF = MOD(ITY,1000)
ITY = ITY/1000
ITECH = MOD(ITY,1000)
INSTR = MOD(MOBHDR(NCMBOX,JJO),10000)
LLZTD = .FALSE.
LLFER = .FALSE.
ZTDERR = -1.0
DO JDATA = IDATA, IDATEND
ITYP = MOBDATA(NCMVNM,JDATA)
IFLG = MOBDATA(NCMFLG,JDATA)
IASS = MOBDATA(NCMASS,JDATA)
ILEM = IFIND(ITYP)
ZVAL = ROBDATA8(NCMVAR,JDATA)
C
IF ( IASS .EQ. 1 .OR. CFAMTYP(IDATYP) .EQ. 'GP') THEN
C
C***********************************************************************
C UPPER AIR DATA
C***********************************************************************
C
IF ( (CFAMTYP(IDATYP) .EQ. 'UA') ) THEN
CALL LATID(ZFACTOR,ILAT1,ILAT2,ZLAT)
ILVL=0
ZLEV=ROBDATA8(NCMPPP,JDATA)
DO JN =1,JPRLEV
ZLVL=SIGN(1.0D0,(ZLEV- FLOAT(NILV(JN)) ) )
ILVL=ILVL + MAX(0.0D0,ZLVL)
END DO
C
IF(ZLAT*ZTORAD .GE. 30. )THEN
MOBDATA(NCMOEC,JDATA)=1
ELSEIF(ZLAT*ZTORAD.GT.-30..AND.ZLAT*ZTORAD.LT.30.)THEN
MOBDATA(NCMOEC,JDATA)=1
ELSE
MOBDATA(NCMOEC,JDATA)=1
ENDIF
C
IF ( (ITYP .EQ. NEUS) .OR. (ITYP .EQ. NEVS) )THEN
ROBDATA8(NCMOER,JDATA)= XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NETS) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NESS) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NEPS ) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NEPN ) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE
C
C *****************************************************************
C INTERPOLATE VERTICALLY AND HORIZONTALLY THE RAOB ERROR STATISTICS
C *****************************************************************
C
C ----------------------------
C 2. FIND THE INTERPOLATION LAYER
C ----------------------------
if ( zlev .le. nilv(1) ) then
ilyr=1
llinterp=.false.
else if ( zlev .ge. nilv(jprlev) ) then
ilyr=jprlev
llinterp=.false.
else
DO JN =1,JPRLEV-1
if ( float(nilv(jn)) .le. zlev .and. float(nilv(jn+1)) .gt. zlev ) then
ilyr=jn
llinterp=.true.
endif
END DO
endif
C ---------------------------
C 2. DO THE INTERPOLATIONS
C ---------------------------
if ( llinterp) then
ZPT = nilv(ilyr)
ZPB = nilv(ilyr+1)
ZWB = LOG(ZLEV/ZPT)/LOG(ZPB/ZPT)
ZWT = 1.0D0 - ZWB
zcof1=zwt*XOSTDEV(ILEM,ilyr,ILAT1) + zwb*XOSTDEV(ILEM,ilyr+1,ILAT1)
zcof2=zwt*XOSTDEV(ILEM,ilyr,ILAT2) + zwb*XOSTDEV(ILEM,ilyr+1,ILAT2)
ROBDATA8(NCMOER,JDATA)=(1.0D0-ZFACTOR)*zcof1 + ZFACTOR*zcof2
else
ROBDATA8(NCMOER,JDATA)=(1.0D0-ZFACTOR)*XOSTDEV
+ (ILEM,ilyr,ILAT1) + ZFACTOR*XOSTDEV(ILEM,ilyr,ILAT2)
endif
ccc debug debut
ccc print *,' seterr:IDBURP,ITYP,ILEM,ilvl,lat1,lat2,'
ccc & ,'fact,XOSTDEV(1),XOSTDEV(2) '
ccc & ,IDBURP,ITYP,ILEM,ilvl,ilat1,ilat2,ZFACTOR
ccc & ,XOSTDEV(ILEM,ILVL,ILAT1),XOSTDEV(ILEM,ILVL,ILAT2)
ccc debug fin
ENDIF
IF( (ITYP .EQ. NEES) .AND. (NINT(ZVAL) .EQ. 30) )THEN
ROBDATA8(NCMOER,JDATA) = ROBDATA8(NCMOER,JDATA)
+ *SQRT(1.8D0)
ENDIF
C
C***********************************************************************
C TOVS DATA
C***********************************************************************
C
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'TO' ) THEN
IF ( ITYP .EQ. NBT1 .OR.
S ITYP .EQ. NBT2 .OR.
S ITYP .EQ. NBT3 )THEN
ICHN = NINT(ROBDATA8(NCMPPP,JDATA))
INDXM = ILANSEA
IF (INDXM .EQ. 2 ) INDXM = 0
INDXREG = ISRCHEQ(MLISREG,NREGST,INDXM)
INDXCLD = ISRCHEQ(MLISCLD,NCLDST,ITECH)
CALL MAP_SAT(IPLATF,IPLATFORM,ISAT)
CALL MAP_INSTRUM(INSTR,INSTRUM,SENSORTYPE)
DO JN = 1, NSENSORS
IF ( IPLATFORM .EQ. PLATFORM (JN) .AND.
& ISAT .EQ. SATELLITE (JN) .AND.
& INSTRUM .EQ. INSTRUMENT(JN) ) THEN
ROBDATA8(NCMOER,JDATA) =
S TOVERRST(ICHN,INDXCLD,INDXREG,JN)
ENDIF
ENDDO
ENDIF
C
C***********************************************************************
C GOES DATA
C***********************************************************************
C
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'GO' ) THEN
IF ( ITYP .EQ. NBT1 .OR.
S ITYP .EQ. NBT2 .OR.
S ITYP .EQ. NBT3 )THEN
ICHN = NINT(ROBDATA8(NCMPPP,JDATA))
INDXREG = ISRCHEQ(MLISREGGO,NREGSTGO,ILANSEA)
INDXCLD = ISRCHEQ(MLISCLDGO,NCLDSTGO,ITECH)
C
C* Currently processed satellite
C* N.B.: 252=GOES08, 253=GOES09, 254=GOES10,
C* 255=GOES11, 256=GOES12, etc...
C
ISATNO = IPLATF - 244
C
INDXSAT = ISRCHEQ(NIDSATGO,NSATGO,ISATNO)
ROBDATA8(NCMOER,JDATA) =
S GOERRST(ICHN,INDXCLD,INDXREG,INDXSAT)
ENDIF
C
C***********************************************************************
C GPS RO DATA
C***********************************************************************
C
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'RO' ) THEN
C
C * Process only refractivity data (codtyp 169)
C
IF ( MOD(MOBHDR(NCMITY,JJO),1000) .EQ. 169 ) THEN
IF ( ITYP .EQ. NEPS ) THEN
ROBDATA8(NCMOER,JDATA) = 50.
ENDIF
IF ( ITYP .EQ. 12001) THEN
ROBDATA8(NCMOER,JDATA) = 10.
ENDIF
IF ( ITYP .EQ. 15036) THEN
C
C * Observation-estimated geopotential height:
C
cc H = ROBDATA8(NCMPPP,JDATA)
C
C * Gross approximation to the refractivity:
C
cc IF ( H .LE. 10000 ) THEN
cc NAPP = EXP( 5.75 - H/8000. )
cc ELSE
cc NAPP = EXP( 4.5 - (H-10000.)/6400. )
cc ENDIF
C
C * Observation error S
C
cc ROBDATA8(NCMOER,JDATA) = 0.05 * NAPP
ROBDATA8(NCMOER,JDATA) = 1001.
ENDIF
ENDIF
C
C***********************************************************************
C ALL GPS GROUND-BASED DATA (SFC MET AND ZTD) ASSIMILATED OR NOT
C***********************************************************************
C
C
C GPS SFC MET ERRORS ARE SET TO SYNO SFC OBS ERRORS FROM S/R SUCOVO
C AND WEIGHTED BY FACTOR YSFERRWGT FOR 3D-VAR FGAT OR 4D-VAR ASSIM.
C OF TIME-SERIES (YSFERRWGT = 1.0 FOR NORMAL 3D-VAR WITH 3D THINNING)
C
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'GP' ) THEN
C* Psfc Error (Pa)
IF ( ITYP .EQ. NEPS ) THEN
ROBDATA8(NCMOER,JDATA) = 75. * YSFERRWGT
ENDIF
C* Tsfc Error (K)
IF ( ITYP .EQ. NETS ) THEN
ROBDATA8(NCMOER,JDATA) = 2.0 * YSFERRWGT
ENDIF
C* T-Td Error (K)
IF ( ITYP .EQ. NESS ) THEN
ROBDATA8(NCMOER,JDATA) = 3.0 * YSFERRWGT
ENDIF
C* ZTD Error Error (DUMMY VALUE so 3DVar won't abort)
IF ( ITYP .EQ. NEFE ) THEN
ROBDATA8(NCMOER,JDATA) = 0.001
LLFER = .TRUE.
ZTDERR = ZVAL
ENDIF
C* ZTD Error
IF ( ITYP .EQ. NEZD ) THEN
IF ( LLCZTDE) ROBDATA8(NCMOER,JDATA) = YZTDERR
ZZTD = ZVAL
IZTDJ = JDATA
LLZTD = .TRUE.
ENDIF
C
C***********************************************************************
C ACARS, ASDAR,ADS, SATOB AIREP DATA
C***********************************************************************
C
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'AI'
& .OR. CFAMTYP(IDATYP) .EQ. 'SW') THEN
ZLEV=ROBDATA8(NCMPPP,JDATA)
C
C SATOB
C
IF ( IDBURP .EQ. 88 .OR. IDBURP .EQ. 188 ) THEN
DELTAPMIN = ABS(LOG(ZLEV*RPATMB)-LOG(XSTDEVLV(1,2)))
ILYR = 1
DO JN = 2, 10
DELTAP = ABS(LOG(ZLEV*RPATMB)-LOG(XSTDEVLV(JN,2)))
IF ( DELTAP < DELTAPMIN ) THEN
DELTAPMIN = DELTAP
ILYR = JN
END IF
END DO
IF ((ITYP .EQ. NEUU) .OR. (ITYP .EQ. NEVV))THEN
ROBDATA8(NCMOER,JDATA)=XSTDEVLV(ILYR,1)
ELSE IF (ITYP .EQ. NETT )THEN
ROBDATA8(NCMOER,JDATA)= SQRT(XSTDEV(4,1))
ENDIF
C
C AIREP
C
ELSE IF (IDBURP .EQ. 128 ) THEN
IF ((ITYP .EQ. NEUU) .OR. (ITYP .EQ. NEVV))THEN
IF ( ZLEV .LT. 500.*RMBTPA ) THEN
ROBDATA8(NCMOER,JDATA)=RMSKNT*SQRT(XSTDEV(2,2))
ELSE
ROBDATA8(NCMOER,JDATA)=RMSKNT*SQRT(XSTDEV(1,2))
ENDIF
ELSE IF (ITYP .EQ. NETT )THEN
ROBDATA8(NCMOER,JDATA)= SQRT(XSTDEV(4,2))
ELSE IF (ITYP .EQ. NEES )THEN
ROBDATA8(NCMOER,JDATA)= SQRT(XSTDEV(5,2))
ENDIF
C
C ASDAR, ACARS + ADS
C
ELSE IF (IDBURP .EQ. 42 .OR. IDBURP .EQ. 157 .OR. IDBURP .EQ. 177) THEN
IF ((ITYP .EQ. NEUU) .OR. (ITYP .EQ. NEVV))THEN
IF ( ZLEV .LT. 500.*RMBTPA ) THEN
ROBDATA8(NCMOER,JDATA)=RMSKNT*SQRT(XSTDEV(2,3))
ELSE
ROBDATA8(NCMOER,JDATA)=RMSKNT*SQRT(XSTDEV(1,3))
ENDIF
ELSE IF (ITYP .EQ. NETT )THEN
ROBDATA8(NCMOER,JDATA)= SQRT(XSTDEV(4,3))
ELSE IF (ITYP .EQ. NEES )THEN
ROBDATA8(NCMOER,JDATA)= SQRT(XSTDEV(5,3))
ENDIF
ENDIF
C
C***********************************************************************
C SURFACE DATA
C***********************************************************************
C
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'SF' ) THEN
C
C SYNOP AND SHIP NON-AUTOMATIQUE
C
ccc debug debut
ccc print *,' seterr:IDBURP,ITYP,ILEM,XSFCOBERR ',IDBURP,ITYP,ILEM
ccc & ,XSFCOBERR(ILEM,1,IDBURP)
ccc debug fin
IF ( (IDBURP .EQ. 12) .OR. (IDBURP .EQ. 13) ) THEN
IF ( (ITYP .EQ. NEUS) .OR. (ITYP .EQ. NEVS) )THEN
ROBDATA8(NCMOER,JDATA)= XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NETS) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NESS) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NEPS ) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NEPN ) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF ( (ITYP .EQ. NEUU) .OR. (ITYP .EQ. NEVV) )THEN
ROBDATA8(NCMOER,JDATA)=RMSKNT*SQRT(XSTDEV(1,4))
ELSE IF (ITYP .EQ. NEGZ) THEN
ROBDATA8(NCMOER,JDATA)=ZCONGZ*SQRT(XSTDEV(3,4))
ELSE IF (ITYP .EQ. NETT) THEN
ROBDATA8(NCMOER,JDATA)=SQRT(XSTDEV(4,4))
ELSE IF (ITYP .EQ. NEES) THEN
ROBDATA8(NCMOER,JDATA)=SQRT(XSTDEV(5,4))
ENDIF
C
C DRIBU AND DRIFTER
C
ELSE IF( (IDBURP .EQ. 14) .OR. (IDBURP .EQ. 18) )THEN
IF ( (ITYP .EQ. NEUS) .OR. (ITYP .EQ. NEVS) )THEN
ROBDATA8(NCMOER,JDATA)= XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NETS) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NESS) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NEPS ) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NEPN ) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF ( (ITYP .EQ. NEUU) .OR. (ITYP .EQ. NEVV) )THEN
ROBDATA8(NCMOER,JDATA)=RMSKNT*SQRT(XSTDEV(1,4))
ELSE IF (ITYP .EQ. NEGZ) THEN
ROBDATA8(NCMOER,JDATA)=ZCONGZ*SQRT(XSTDEV(3,4))
ELSE IF (ITYP .EQ. NETT) THEN
ROBDATA8(NCMOER,JDATA)=SQRT(XSTDEV(4,4))
ELSE IF (ITYP .EQ. NEES) THEN
ROBDATA8(NCMOER,JDATA)=SQRT(XSTDEV(5,4))
ENDIF
C
C STATION AUTOMATIQUE, PATROL SHIPS
C
ELSE IF((IDBURP .GE. 145) .AND. (IDBURP .LE. 147))THEN
IF ( (ITYP .EQ. NEUS) .OR. (ITYP .EQ. NEVS) )THEN
ROBDATA8(NCMOER,JDATA)= XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NETS) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NESS) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NEPS ) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF (ITYP .EQ. NEPN ) THEN
ROBDATA8(NCMOER,JDATA)=XSFCOBERR(ILEM,1,IDBURP)
ELSE IF ( (ITYP .EQ. NEUU) .OR. (ITYP .EQ. NEVV) )THEN
ROBDATA8(NCMOER,JDATA)=RMSKNT*SQRT(XSTDEV(1,4))
ELSE IF (ITYP .EQ. NEGZ) THEN
ROBDATA8(NCMOER,JDATA)=ZCONGZ*SQRT(XSTDEV(3,4))
ELSE IF (ITYP .EQ. NETT) THEN
ROBDATA8(NCMOER,JDATA)=SQRT(XSTDEV(4,4))
ELSE IF (ITYP .EQ. NEES) THEN
ROBDATA8(NCMOER,JDATA)=SQRT(XSTDEV(5,4))
ENDIF
ENDIF
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'SC' ) THEN
ROBDATA8(NCMOER,JDATA)= XSFCOBERR(ILEM,1,IDBURP)
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'TO' ) THEN
ILVL=INT(ROBDATA8(NCMPPP,JDATA))
ROBDATA8(NCMOER,JDATA)= 1.0D0
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'OZ' ) THEN
ROBDATA8(NCMOER,JDATA)=
s 0.6D0*ROBDATA8(NCMVAR,JDATA)
C
C SATEMS
C
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'ST' ) THEN
ILVL=0
ZLEV=ROBDATA8(NCMPPP,JDATA)
DO JN =1,JPSALEV
ZLVL=SIGN(1.0D0,(ZLEV-NISLV(JN)) )
ILVL=ILVL + MAX(0.0D0,ZLVL)
END DO
IF ( (ITECH .EQ. 1) .OR. (ITECH .EQ. 4) ) THEN
ROBDATA8(NCMOER,JDATA)= XSATDEV(ILVL,1)
MOBDATA(NCMOEC,JDATA)= 1
ELSE IF ( (ITECH .EQ. 2) .OR. (ITECH .EQ. 3) ) THEN
ROBDATA8(NCMOER,JDATA)= XSATDEV(ILVL,2)
MOBDATA(NCMOEC,JDATA)= 2
ELSE
ROBDATA8(NCMOER,JDATA)= XSATDEV(ILVL,1)
MOBDATA(NCMOEC,JDATA)= 1
ENDIF
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'HU' ) THEN
ELSE IF ( CFAMTYP(IDATYP) .EQ. 'PR' ) THEN
ROBDATA8(NCMOER,JDATA)= 2.2
ELSE
WRITE(NULOUT,*)' UNKNOWN DATA FAMILY:',CFAMTYP(IDATYP)
ENDIF
C
C***********************************************************************
C Check for case where error should have been set but was
C not. 3dvar will abort in this case.
C***********************************************************************
C
IF (CFAMTYP(IDATYP) .NE. 'GP') THEN
IF(ROBDATA8(NCMOER,JDATA) .LE. 0.0) THEN
LLBAD = .TRUE.
ENDIF
C
ELSE
C GP FAMILY CASE
IF (IASS .EQ. 1) THEN
IF ((.NOT. LLZTD) .AND. ROBDATA8(NCMOER,JDATA) .LE. 0.0) THEN
LLBAD = .TRUE.
ENDIF
IF ((LLZTD .AND. LLCZTDE) .AND. ROBDATA8(NCMOER,JDATA) .LE. 0.0) THEN
LLBAD = .TRUE.
ENDIF
ENDIF
ENDIF
C
IF (LLBAD) THEN
WRITE(NULOUT,*)' PROBLEM OBSERR VARIANCE FAM= '
& ,CFAMTYP(IDATYP)
WRITE(NULOUT,
& '(1X,"STNID= ",A10,"IDBURP= ",I5," LAT= ",F10.2
& ," LON = ",F10.2)')
& CSTNID(JJO),IDBURP,ZLAT*ZTORAD,ZLON*ZTORAD
WRITE(NULOUT,'(1X,"ELEMENT= ",I6," LEVEL= ",F10.2,
& " OBSERR = ",E10.2)')
& ITYP,ROBDATA8(NCMPPP,JDATA),ROBDATA8(NCMOER,JDATA)
ENDIF
ELSE
c set artificial obs errors for ln q.
IF ( CFAMTYP(IDATYP) .EQ. 'UA' .AND.
& ( ITYP .EQ. NEHU .OR.
& ITYP .EQ. NEHS ) ) THEN
ROBDATA8(NCMOER,JDATA) = 888.0
ENDIF
C end of assim=1 or GP family IF
ENDIF
C
C end of JDATA loop over observed elements at a location (obs)
END DO
C
C ------------------------------------------------------
C SET THE GB-GPS ZTD ERROR
C ------------------------------------------------------
C
IF ( CFAMTYP(IDATYP) .EQ. 'GP' ) THEN
IF ( .NOT. LLCZTDE ) THEN
IF (LLZTD) THEN
C Compute minimum ZTD error as a function of ZTD using regression
C statistics SD(O-P)
ZMINZDE = Z3*ZZTD**3 + Z2*ZZTD**2 + Z1*ZZTD + ZC
ZMINZDE = ZMINZDE * ZOPEFAC * 0.001
IF (LLRZTDE) THEN
ROBDATA8(NCMOER,IZTDJ) = MAX(ZZDERMIN, ZMINZDE)
ELSE
IF (LLFER) THEN
ROBDATA8(NCMOER,IZTDJ) = MAX(ZZDERMIN, ZTDERR*ZTDERFAC)
ELSE
ROBDATA8(NCMOER,IZTDJ) = MAX(ZZDERMIN, ZMINZDE)
ENDIF
ENDIF
ENDIF
ENDIF
C *** APPLY TIME-SERIES WEIGHTING FACTOR TO OBSERVATION ERROR (YZDERRWGT=1 FOR 3D-VAR)
IF (LLZTD) ROBDATA8(NCMOER,IZTDJ) = ROBDATA8(NCMOER,IZTDJ)*YZDERRWGT
ENDIF
C end of JJO loop over locations (obs)
END DO
C
400 CONTINUE
IF(LLBAD) THEN
WRITE(NULOUT,*)'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
WRITE(NULOUT,*)' Warning 3DV:seterr: PROBLEM OBSERR VARIANCE'
& ,' SEE LISTING FOR MORE DETAILS'
WRITE(NULOUT,*)'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
CALL ABORT3D(NULOUT,'SETERR:PROBLEM OBSERR VARIANCE.')
ENDIF
WRITE(NULOUT,'(10X,"DONE SETERR")')
WRITE(NULOUT,'(10X,"-----------------",/)')
RETURN
END