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 <soft_info> and <stat_trim> (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 <stat_trim> 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