C=============================================================================C
C International Comprehensive Ocean-Atmosphere Data Set (ICOADS) 31 Jan 2005 C
C Filename:level: trimqc0.f:01D Fortran 77 library C
C Purpose: Synthesize QC flags (LMR/LMRF or IMMA) Author: S. Lubker et al. C
C=============================================================================C
C Software Revision Information (previous version: 11 April 2002, level 01C):
C No Fortran code changes; comments modified for IMMA.
C-----------------------------------------------------------------------3456789
C Software documentation for the (invariant) user-interface routine {trimqc0}:
C
C Functionality: This routine can be used with either the LMRF or LMR
C read program ({rdlmrf6} or {rdlmr6}), or the IMMA read program ({rdimma0}),
C to synthesize the trimming and other QC flags into a set of higher-level
C flags, using different options described in detail below.
C
C Machine dependencies: None known.
C For more information: See and (electronic documents).
C=============================================================================C
C WARNING: Code beyond this point should not require any modification. C
C=============================================================================C
C-----------------------------------------------------------------------3456789
SUBROUTINE TRIMQC0(YR,DCK,SID,PT,DS,MISS,TRFLG
+ ,ZZQF,SZQF,AZQF,WZQF,PZQF,RZQF
+ ,OPDN,OPPT,OPSE,OPCQ,OPTF,OP11)
c-----Synthesize the contents of the LMRF trimming section (or LMR trimming
c attachment) (trflg) into higher-level flags signaling acceptance (0)
c or rejection (1) of an entire report (zzqf), or of elements within
c the report (szqf: SST; azqf: AT; wzqf: wind; pzqf: SLP; rzqf: relative
c humidity). Also required as input are these LMRF/LMR fields, and the
c FMISS missing value, transformed into integers: year (YR), deck (DCK),
c source ID (SID), platform type (PT), and dup status (DS); and MISS.
c
c Alternatively, the data may be input from the IMMA format (core and
c ICOADS attachment), and this routine will perform the same function.
c However, the abbreviation in IMMA (and parameter in {rdimma0}) for
c dup status is DUPS, rather than DS. The other field abbreviations,
c and the contents of trflg (as returned by {gettrf} when called from
c {rdimma0}), are equivalent between LMRF/LMR and IMMA.
c
c The following reports are automatically flagged for rejection, with
c two exceptions for earlier data noted (see for details):
c uncertain dups: DS > 2
c (exception: DS=6 retained before 1950)
c landlocked: LZ = 1 (according to 2-deg check)
c report-status: if flagged by NCDC-QC (ZQ = 1 or 3)
c (NOTE: includes 1-deg landlock check); and
c if flagged (only) by MEDS < 1993 (ZQ = 2)
c (exception: report-status ignored before 1950)
c time period: based on source ID starting in 1980
c
c Report rejections are tuned using the following options
c (* options are used for standard/enhanced MSG; see NOTE below):
c opdn: 0 = include all data*
c 1 = local nighttime only (reject daytime)
c 2 = local daytime only (reject nighttime)
c oppt: 0 = standard: ship only (reject non-ship)*
c 1 = enhanced: include all data*
c
c Element rejections are tuned using the following options
c (* options are used for standard/enhanced MSG; see NOTE below):
c opse: 0 = source exclusion flags: used (plus SID=70/71
c wind data are rejected starting in 1980)*
c 1 = source exclusion flags: ignored
c opcq: 0 = composite QC flags: used*
c 1 = composite QC flags: ignored
c optf: 0 = trimming: reject outside 2.8 sigma
c 1 = trimming: standard (reject outside 3.5 sigma)*
c 2 = trimming: enhanced (reject outside 4.5 sigma)*
c 3 = trimming: untrimmed (op11 has no effect;
c Note: data with trimming flag values > 12 are
c deemed unusable/not computable and rejected)
c op11: 0 = trimming flag=11: data rejected*
c 1 = trimming flag=11: data used*
c
c NOTES: Option settings: opdn oppt opse opcq optf op11
c standard MSG: 0 0 0 0 1 0
c enhanced MSG: 0 1 0 0 2 1
c untrimmed MSG: 0 1 0 1 3 -
c When optf=3, op11 has no effect, hence "-" for untrimmed.
c Since opse=0, some data are excluded from untrimmed statistics.
IMPLICIT INTEGER(A-Z)
DIMENSION TRFLG(23)
C CHECK IF TRIMMING FLAGS MISSING
IF(TRFLG(1).EQ.0) THEN
PRINT *,'TRIMQC0 ERROR. TRIMMING FLAGS MISSING'
STOP
ENDIF
C CHECK RANGES OF OPTIONS
IF(OPDN.LT.0.OR.OPDN.GT.2) THEN
PRINT *,'TRIMQC0 ERROR. OPDN=',OPDN
STOP
ENDIF
IF(OPPT.LT.0.OR.OPPT.GT.1) THEN
PRINT *,'TRIMQC0 ERROR. OPPT=',OPPT
STOP
ENDIF
IF(OPSE.LT.0.OR.OPSE.GT.1) THEN
PRINT *,'TRIMQC0 ERROR. OPSE=',OPSE
STOP
ENDIF
IF(OPCQ.LT.0.OR.OPCQ.GT.1) THEN
PRINT *,'TRIMQC0 ERROR. OPCQ=',OPCQ
STOP
ENDIF
IF(OPTF.LT.0.OR.OPTF.GT.3) THEN
PRINT *,'TRIMQC0 ERROR. OPTF=',OPTF
STOP
ENDIF
IF(OP11.LT.0.OR.OP11.GT.1) THEN
PRINT *,'TRIMQC0 ERROR. OP11=',OP11
STOP
ENDIF
C
B2 = TRFLG(1)
ND = TRFLG(2)
SF = TRFLG(3)
AF = TRFLG(4)
UF = TRFLG(5)
VF = TRFLG(6)
PF = TRFLG(7)
RF = TRFLG(8)
ZQ = TRFLG(9)
SQ = TRFLG(10)
AQ = TRFLG(11)
WQ = TRFLG(12)
PQ = TRFLG(13)
RQ = TRFLG(14)
XQ = TRFLG(15)
CQ = TRFLG(16)
EQ = TRFLG(17)
LZ = TRFLG(18)
SZ = TRFLG(19)
AZ = TRFLG(20)
WZ = TRFLG(21)
PZ = TRFLG(22)
RZ = TRFLG(23)
C
C REPORT REJECTION
ZZQF = 1
C
IF(OPDN.EQ.1) THEN
IF(ND.EQ.2) RETURN
ELSE IF(OPDN.EQ.2) THEN
IF(ND.EQ.1) RETURN
ENDIF
IF (DS.GT.2 .AND. (YR.GE.1950 .OR. DS.NE.6)) RETURN
IF (LZ.EQ.1) RETURN
IF ((ZQ.EQ.1 .OR. ZQ.EQ.3) .AND. YR.GE.1950) RETURN
IF (YR.GE.1980) THEN
IF (SID.EQ.25 .AND. YR.GT.1984) RETURN
IF (SID.EQ.30 .AND. YR.GT.1984) RETURN
IF (SID.EQ.33 .AND. YR.LT.1986) RETURN
IF (OPPT.EQ.0) THEN
IF (.NOT.(PT.EQ.2 .OR. PT.EQ.5 .OR. PT.EQ.MISS
+ .AND. DCK.EQ.888)) RETURN
IF (SID.EQ.70) RETURN
IF (SID.EQ.71) RETURN
ENDIF
ELSE
IF (OPPT.EQ.0) THEN
IF (PT.GT.5 .AND. PT.NE.MISS) RETURN
IF (SID.EQ.70) RETURN
IF (SID.EQ.71) RETURN
ENDIF
ENDIF
C
C ELEMENT REJECTION
ZZQF = 0
SZQF = 0
AZQF = 0
WZQF = 0
PZQF = 0
RZQF = 0
C
C SOURCE EXCLUSION FLAGS
IF(OPSE.EQ.0) THEN
IF (SZ.EQ.1) SZQF = 1
IF (AZ.EQ.1) AZQF = 1
IF (WZ.EQ.1) WZQF = 1
IF (YR.GE.1980) THEN
IF (SID.EQ.70 .OR. SID.EQ.71) WZQF = 1
ENDIF
IF (PZ.EQ.1) PZQF = 1
IF (RZ.EQ.1) RZQF = 1
ENDIF
C COMPOSITE QC FLAGS
IF(OPCQ.EQ.0) THEN
IF (SQ.GT.0) SZQF = 1
IF (AQ.GT.0) AZQF = 1
IF (WQ.GT.0) WZQF = 1
IF (PQ.GT.0) PZQF = 1
IF (RQ.GT.0) RZQF = 1
ENDIF
C TRIMMING FLAGS
IF(OPTF.LT.3) THEN
IF (SF.GT.OPTF*2+1) THEN
IF(OP11.EQ.0.OR.SF.NE.11) THEN
SZQF = 1
ENDIF
ENDIF
IF (AF.GT.OPTF*2+1) AZQF = 1
IF (UF.GT.OPTF*2+1 .OR. VF.GT.OPTF*2+1) WZQF = 1
IF (PF.GT.OPTF*2+1) THEN
IF(OP11.EQ.0.OR.PF.NE.11) THEN
PZQF = 1
ENDIF
ENDIF
IF (RF.GT.OPTF*2+1) RZQF = 1
ELSE IF(OPTF.EQ.3) THEN
IF (SF.GT.12) SZQF = 1
IF (AF.GT.12) AZQF = 1
IF (UF.GT.12 .OR. VF.GT.12) WZQF = 1
IF (PF.GT.12) PZQF = 1
IF (RF.GT.12) RZQF = 1
ENDIF
END