CMAX: [Version 1.0 (6/22/93)]
CMAX: ----------------------------------------------------
CMAX: Transformation of BUDCHK from budchk.f
CMAX: ----------------------------------------------------
C......................................................................
C                                                                     .
C  Program:    BUDCHK                                                 .
C  Language:   FORTRAN V (ANSI-77 STANDARD)                           .
C  Computer:   Cray YMP 4/832                                         .
C                                                                     .
C  Programmer: Y. BRIN    ("DECYBERIZATION" BY M.SEABLOM)             .
C  Date:       FEBRUARY, 1990                                         .
C                                                                     .
C  PROGRAM BUDCHK PERFORMS BUDDY CHECKING ON THOSE DELTAS WHICH FAILED.
C  THE GROSS CHECK.                                                   .
C                                                                     .
C                                                                     .
C......................................................................
C**********************************************************************
C*                                                                    *
C*  N A S A   O P T I M U M   I N T E R P O L A T I O N   -   O 9 X   *
C*               Global Modeling and Simulation Branch                *
C*                   GODDARD SPACE FLIGHT CENTER                      *
C*                                                                    *
C**********************************************************************
      SUBROUTINE budchk(kx,lat,lon,delt,nobs)
      REAL KX (NOBS), LAT (NOBS), LON (NOBS), DELT (NOBS), BUDDIST, BUDL
     &AT, CUTVAL (20000), IBAD (20000), IGOOD (20000)
      INTEGER BGRS (20000), BACC (20000), BBUD (20000), BCHK (20000)
      CHARACTER * 60 message
C MAXIMUM BAD/GOOD LIST SIZE, BATCH SIZE,NUMBER OF NEIGHBORING POINTS.
      COMMON / BUDDY / MAXLEV, MAXLIST, MAXBATCH, MAXINDX, BUDDIST, BUDL
     &AT
C PRINT FLAG
      COMMON / PRINT / MSGLEV
      COMMON / BUDBITS / BGRS, BACC, BBUD, BCHK
C LOCAL VARIABLES. USE BLANK COMMON BLOCK.
      COMMON CUTVAL, IGOOD, IBAD
!hpf$ distribute bacc(block)
!hpf$ distribute bbud(block)
!hpf$ distribute bchk(block)
!hpf$ distribute bgrs(block)
!hpf$ distribute cutval(block)
!hpf$ distribute delt(block)
!hpf$ distribute ibad(block)
!hpf$ distribute igood(block)
!hpf$ distribute kx(block)
!hpf$ distribute lat(block)
!hpf$ distribute lon(block)
      message(1:60) = ' '
C INITIALIZE OUTPUT ARRAYS
      bbud = 0
      bchk = 0
      ngood = 0
      nbad = 0
      naccept = 0
C CREATE LISTS OF GOOD / BAD REPORTS.
      DO 7002 i = 1 , nobs
        IF (bacc(i) .EQ. 1) THEN
          ngood = ngood + 1
          IF (ngood .GT. maxlist) THEN
            message = ' NGOOD exceeds MAXLIST in subroutine BUDCHK.'
            CALL flash(5,message,1)
          ENDIF
          igood(ngood) = i
        ELSE
          nbad = nbad + 1
          IF (nbad .GT. maxlist) THEN
            message = ' NBAD exceeds MAXLIST in subroutine BUDCHK.'
            CALL flash(5,message,1)
          ENDIF
          ibad(nbad) = i
        ENDIF
    1   CONTINUE
 7002 CONTINUE
      IF (ngood .LT. 1) THEN
        message = ' BUDCHK: All reports have failed quality control.'
        CALL flash(4,message,1)
      ENDIF
      IF (nbad .LT. 1) THEN
        WHERE (bacc(:nobs) .EQ. 1 .OR. bbud(:nobs) .EQ. 1)
          bbud(:nobs) = 1
        ELSEWHERE
          bbud(:nobs) = 0
        ENDWHERE
        RETURN
      ENDIF
      IF (msglev .GT. 0) THEN
        WRITE( 6,'('' BUDCHK: NBAD, NGOOD:'',2I8)' ) nbad,ngood
      ENDIF
C   CALL BDBATCH TO PERFORM THE BUDDY CHECK.
      CALL bdbatch(kx,lat,lon,delt,nobs,nbad,ngood)
C   BBUD POINTS TO REPORTS THAT ARE NO LONGER BAD - PASSED BUDDY CHECK.
      IF (msglev .GT. 5) THEN
        DO i = 1 , nobs
          IF (bbud(i) .EQ. 1) THEN
            naccept = naccept + 1
          ENDIF
        ENDDO
        WRITE( 6,'('' BDBATCH:'',I8,'' ACCEPTED.'')' ) naccept
        DO i = 1 , nobs
          IF (bbud(i) .EQ. 1) THEN
            WRITE( 6,'('' ACCEPTED BY BDBATCH '',I6,         3F10.2,'' '
     &',E14.7)' ) i,kx(i),lat(i),lon(i),delt(i)
          ENDIF
        ENDDO
      ENDIF
      WHERE (bacc(:nobs) .EQ. 1 .OR. bbud(:nobs) .EQ. 1)
        bbud(:nobs) = 1
      ELSEWHERE
        bbud(:nobs) = 0
      ENDWHERE
      RETURN
      END
