c---------------------------------------------------------------------c
c         N A S A   /  G M S B   A N A L Y S I S   G R O U P          c
c    Optimum Interpolation Analysis System   Version 1.2  Fall, 1991  c
c                                                                     c
c                                                                     c
c    Program Name: SQCRPT ( Surface Quality Control Report )          c
c    Programmer  : Michael Seablom, NASA/GSFC Code 911                c
c                  Greenbelt, MD 20771  (301)286-7360 (FTS)888-7360   c
c                                                                     c
c    Date        : August 22, 1991                                    c
c    Computer    : Cray YMP 464                                       c
c    Language    : Cray Fortran (CFT77 Version 4.0)                   c
c                                                                     c
c  Program SQCRPT prints out surface quality control statistics.      c
c  This subroutine is patterned after QCREPORT which performs similar c
c  duties in the upper air analysis.                                  c
c                                                                     c
c---------------------------------------------------------------------c
 
 
      subroutine sqcrpt ( data, nobs, type, nymd, nhms )
 
      real        data(max_data)
      integer     nobs, statistics(200,10), testval,
     &            type
      character*6 analysis_time, date_temp, time_temp
      character*8 dataname, obsname, analysis_date
      logical     qobs, offlev, onestage
 
      common /scan/ maxobs, rscan, onestage, max_data
      common /dataptrs/ ikx,ilat,ilon,iprs,ityp,idel,ifcer
 
      common /obs/ maxdex, nfgge, lun, dataname(5), hh(13,13,20),
     &             vcoroe(18,18,4), obserr(200,4,19), ww(13,13,20),
     &             obsname(200), qobs(200,5), offlev(200)
 
 
      data statistics / 2000*0 /
 
 
 1000 format(//,5x,"Data",8x,"Total",6x,"Number",4x," Suspect Observat",
     &       "ions",2x,"Gross Check  Reaccepted ",4x,"Mean Fcst Error",
     &       10x,"RMS - Delta",/,5x,"Type",7x,"Reports",4x,"Accepted",
     &       5x,"Total",6x,"Accepted",4x,"Failures",2x,"Buddy Check",
     &       5x,"Pass",8x,"Fail",8x,"Pass",8x,"Fail",/)
 
      write(6,'("1",//,1x,130("-"),//,44x,"Quality Control, Version"
     &      " 2.1   Autumn, 1991",//,130("-"),//)')
 
      write (date_temp,'(i6)') nymd
      analysis_date = date_temp(3:4) // '/' // date_temp(5:6) // '/'
     &                // date_temp(1:2)
      write (time_temp,'(bz,i6)') nhms
      analysis_time = time_temp(1:2) // ':' // time_temp(3:4) // 'Z'
      if ( nhms .eq. 0 )  analysis_time = ' 0:00Z'
      iuwnd = idel + nobs
      ivwnd = iuwnd + nobs
      ife   = ivwnd + nobs
 
 
      write(6,'(///)')
      if ( type .eq. 1 ) write(6,'(/," SEA LEVEL PRESSURE STATIS",
     &  "TICS    VARIABLE TOLERANCES",/," Analysis",
     &  " date: ",a8,3x,"Analysis time: ",bz,a6)')
     &   analysis_date, analysis_time
 
 
      if ( type .ne. 1 ) write(6,'(/," OCEAN SURFACE WIND STA",
     &  "TISTICS   VARIABLE TOLERANCES",/," Analysis",
     &  " date: ",a8,3x,"Analysis time: ",bz,a6)')
     &   analysis_date, analysis_time
 
      write(6,1000)
 
      statistics( 1:200, 1:10 ) = 0
 
 
c Tally the total number of observations for each data type.
 
        do 2 j = 1,200
          do i = 1,nobs
 
            if ( data(ikx+i-1) .eq. float(j) )
     &        statistics(j,1) = statistics(j,1) + 1
 
          end do
 
c Total the number of accepted reports.
 
        do i = 1,nobs
 
          if ((int(data(ityp+i-1)) .eq. type .or.
     &         int(data(ityp+i-1)) .eq. 3) .and.
     &         data(ikx+i-1) .eq. float(j) )
     &                  statistics(j,2) = statistics(j,2) + 1
 
        end do
 
c Number of suspect observations. If type = 1, pressure observations
c are being tallied, otherwise tally wind observations.
 
        if ( type .eq. 1 ) then
 
c Suspicious pressure observations.
 
          do i = 1,nobs
           if ( data(ikx+i-1) .eq. float(j) ) then
            testval = int( data( ityp+i-1 ) * 10. )
 
            if ( testval .eq. 13 .or. testval .eq. 3 )
     &        statistics(j,3) = statistics(j,3) + 1
 
            if ( testval .eq. 13 )
     &        statistics(j,4) = statistics(j,4) + 1
 
c Gross check failures.
 
            if ( testval .eq. 12 .or. testval .eq. 1 )
     &        statistics(j,5) = statistics(j,5) + 1
 
c Number reaccepted by buddy check.
 
            if ( testval .eq. 12 ) statistics(j,6) = statistics(j,6) + 1
           end if
          end do
 
       else
 
c Suspicious wind observations.
 
          do i = 1,nobs
           if ( data(ikx+i-1) .eq. float(j) ) then
            testval = int( data( ityp+i-1) * 100. ) -
     &                int( data( ityp+i-1 ) * 10.)* 10
 
            if ( testval .eq. 3 ) then
              statistics(j,3) = statistics(j,3) + 1
 
              if ( int(data(ityp+i-1)) .eq. 2 .or.
     &           int(data(ityp+i-1)) .eq. 3 )
     &           statistics(j,4) = statistics(j,4) + 1
 
            end if
 
c Gross check failures.
 
            if ( testval .eq. 2 .or. testval .eq. 1 )
     &        statistics(j,5) = statistics(j,5) + 1
 
c Number reaccepted by buddy check.
 
            if ( testval .eq. 2 )
     &         statistics(j,6)= statistics(j,6) + 1
           end if
          end do
 
       end if
 
 
c Average forecast errors and deltas for observations which passed and
c failed the quality control.
 
       fe_accept = 0.
       fe_fail   = 0.
       delta_accept = 0.
       delta_fail   = 0.
       number_accept = 0
       number_fail   = 0
 
       if ( type .eq. 1 ) then
 
         do i = 1,nobs
          if ( data(ikx+i-1) .eq. float(j) ) then
           itype = int( data( ityp+i-1 ) )
 
           if ( itype .eq. 1 .or. itype .eq. 3 ) then
 
              number_accept = number_accept + 1
              fe_accept = fe_accept + data( ife+i-1 )
              delta_accept = delta_accept + (data( idel+i-1))**2
 
           else if ( int( data(ityp+i-1)*10.) .ne. 4 ) then
 
              number_fail = number_fail + 1
              fe_fail = fe_fail + data( ife+i-1 )
              delta_fail = delta_fail + (data( idel+i-1))**2
 
           end if
          end if
         end do
 
       else
 
         do i = 1,nobs
          if ( data(ikx+i-1) .eq. float(j) ) then
           itype = int( data( ityp+i-1 ) )
 
           if ( itype .eq. 2 .or. itype .eq. 3 ) then
 
              number_accept = number_accept + 1
              fe_accept = fe_accept + data( ife+i-1 )
              delta_accept = delta_accept +
     &         (sqrt(data(iuwnd+i-1)**2  +
     &               data( ivwnd+i-1 ) **2 ))**2
 
           else
            testval = int( data( ityp+i-1) * 100. ) -
     &                int( data( ityp+i-1 ) * 10.)* 10.
            if ( testval .ne. 4 ) then
 
              number_fail = number_fail + 1
              fe_fail = fe_fail + data( ife+i-1 )
              delta_fail = delta_fail +
     &                      (sqrt( data(iuwnd+i-1) **2 +
     &                       data( ivwnd+i-1 ) ** 2 ))**2
 
            end if
           end if
          end if
         end do
 
         end if
 
         if ( number_fail .ne. 0 ) then
           fe_fail = fe_fail / float( number_fail )
           delta_fail = sqrt(delta_fail / float( number_fail ))
         end if
         if ( number_accept .ne. 0 ) then
           fe_accept = fe_accept / float( number_accept )
           delta_accept = sqrt(delta_accept / float( number_accept ))
         end if
         if ( statistics(j,1) .ne. 0 ) write(6,'(1x,a8,6i12,4e12.4)')
     &      obsname(j), ( statistics(j,ii),ii=1,6), fe_accept, fe_fail,
     &      delta_accept, delta_fail
 
 2      continue
 
 1    continue
      return
      end
