C=============================================================================C
C Comprehensive Ocean-Atmosphere Data Set (COADS):         Fortran 77 Library C
C Filename:level: trimqc1.f:01B                                 22 April 2002 C
C Subroutine:                                       Author: S. Worley  et al. C
C Correction: add IMPLICIT statement, sjw, 8 March 2001.                      C
C Updated comments, sdw, 22 April 2002.                                       C
C=============================================================================C
C Software documentation for the (invariant) user-interface routine {trimqc1}:
C
C Functionality:  This routine can be used with the LMRF read program.  It
C uses the trimming and other QC flags in each LMRF record to reject entire
C reports, or to reject individual data elements within the reports.  Six
C input arguments provide extensive options for using, or ignoring, the QC
C flags.  Subroutine {trimqc0.f} is required and also contains documentation
C for the option settings.
C
C Machine dependencies:  None known.
C For more information: See <lmr>, <lmrf>, and <stat_trim> (electronic
C documents).
C=============================================================================C
C WARNING:  Code beyond this point should not require any modification.       C
C=============================================================================C
C-----------------------------------------------------------------------3456789
      SUBROUTINE TRIMQC1 (FTRUE,FMISS,IREJECT,
     *                   FSST,FAT,FD,FW,FSLP,FWBT,FDPT,
     *                   OPDN,OPPT,OPSE,OPCQ,OPTF,OP11)
c-----Apply the trimming and other QC flags to an LMRF data record using
c     subroutine {trimqc0.f}.  Report rejections are tuned using opdn
c     and oppt; element rejections are tuned using opse, opcq, optf, and
c     op11.  Refer to comments within {trimqc0.f} for details about those
c     input arguments.  Other input arguments:
c          ftrue: real array containing data from the location, regular,
c                 control, and trimming sections of the LMRF report.
c          fmiss: missing value constant, e.g., -999.
c     After application of the QC, (integer) output argument ireject
c     indicates whether the report was rejected:
c          ireject: 0 = report accepted
c                   1 = report rejected (fsst,...,fdpt set to fmiss)
c    If ireject=0, the remaining (real) output arguments return any extant
c    data elements that passed the QC screening:
c          fsst:    The LMRF SST value, i.e., ftrue(sst), if it passed the
c                   QC screening; or fmiss if it failed (or it was missing).
c          fat:     Similarly for AT.
c          fd:      Similarly for D.
c          fw:      Similarly for W.
c          fslp:    Similarly for SLP.
c          fwbt:    Similarly for WBT.
c          fdpt:    Similarly for DPT.
      IMPLICIT INTEGER(A-E,G-Z) 
      PARAMETER(B10=1,YR=2,MO=3,DY=4,HR=5,TI=6,LON=7,LAT=8,LI=9,DCK=10
     +,SID=11,PT=12,QI=13,DS=14,DC=15,TC=16,PB=17,DI=18,D=19,WI=20,W=21
     +,VI=22,VV=23,WW=24,W1=25,W2=26,SLP=27,T1=28,AT=29,WBT=30,DPT=31
     +,SST=32,SI=33,N=34,NH=35,CL=36,HI=37,H=38,CM=39,CH=40,WD=41,WP=42
     +,WH=43,SD=44,SP=45,SH=46,C1=47,C2=48,SC=49,SS=50,A=51,PPP=52,IS=53
     +,ES=54,RS=55,II=56,ID1=57,ID2=58,ID3=59,ID4=60,ID5=61,ID6=62
     +,ID7=63,ID8=64,OS=65,OP=66,T2=67,IX=68,WX=69,SX=70,IRD=71,A6=72
     +,CK=73)
      PARAMETER(B2=74,ND=75,SF=76,AF=77,UF=78,VF=79,PF=80,RF=81,ZQ=82
     +,SQ=83,AQ=84,WQ=85,PQ=86,RQ=87,XQ=88,CQ=89,EQ=90,LZ=91,SZ=92,AZ=93
     +,WZ=94,PZ=95,RZ=96)
            
      DIMENSION FTRUE(*)
      INTEGER IYR,IDCK,ISID,IPT,IDS,MISS,TRFLG(23),ZZQF,SZQF,AZQF,WZQF,
     *        PZQF,RZQF,OPDN,OPPT,OPSE,OPCQ,OPTF,OP11
     
      IYR   = NINT(FTRUE(YR))
      IDCK  = NINT(FTRUE(DCK))
      ISID  = NINT(FTRUE(SID))
      IPT   = NINT(FTRUE(PT))
      IDS   = NINT(FTRUE(DS))
      MISS  = NINT(FMISS)
      DO I = 1,23
         TRFLG(I)=NINT(FTRUE(I+73))
      ENDDO
      FSST = FMISS
      FAT  = FMISS
      FD   = FMISS
      FW   = FMISS
      FSLP = FMISS
      FWBT = FMISS
      FDPT = FMISS
      
      CALL TRIMQC0(IYR,IDCK,ISID,IPT,IDS,MISS,TRFLG,
     *             ZZQF,SZQF,AZQF,WZQF,PZQF,RZQF,
     *             OPDN,OPPT,OPSE,OPCQ,OPTF,OP11)
     
      IREJECT=0                   !RECORD REJECTION
      IF(ZZQF.EQ.1)THEN
        IREJECT = 1
	RETURN
      ENDIF
           
      FSST = FTRUE(SST)           ! SST FLAG AND QC APPLICATION
      IF(SZQF.EQ.1)FSST= FMISS
      FAT  = FTRUE(AT)            ! AT FLAG AND QC APPLICATION
      IF(AZQF.EQ.1)FAT = FMISS
      FD   = FTRUE(D)             ! WIND, D AND W FLAG AND QC APPLICATION
      FW   = FTRUE(W)
      IF(WZQF.EQ.1)THEN
        FD  = FMISS	
        FW  = FMISS
      ENDIF
      FSLP = FTRUE(SLP)           ! SLP FLAG AND QC APPLICATION
      IF(PZQF.EQ.1)FSLP= FMISS      
      FWBT = FTRUE(WBT)          ! WBT AND DPT FLAG AND QC APPLICATION
      FDPT = FTRUE(DPT)           
      IF(RZQF.EQ.1)THEN           
        FWBT  = FMISS	
        FDPT  = FMISS
      ENDIF	      		
	          	 
      RETURN
      END