SUBROUTINE AT_CKST  ( string )

C************************************************************************
C* AT_CKST								*
C*									*
C* This routine checks the value of a character string unpacked from the*
C* input BUFR stream.  If the string contains some unorthodox value such*
C* as "UNKNOWN", "UNSPECIFIED", "??????", etc., or if it contains any   *
C* control characters or consists of all blank characters, then it is   *
C* set to the correct BUFR "missing" value for strings (i.e. all bits   *
C* set to 1) for subsequent encoding into the output BUFR stream.      	*
C*									*
C* AT_CKST ( STRING )					  		*
C*									*
C* Input parameters:							*
C*	STRING		CHAR*		String				*
C*									*
C* Output parameters:							*
C*	STRING		CHAR*		String, possibly overwritten by	*
C*					setting all bits to 1		*
C**									*
C* Log:									*
C* J. Ator/NCEP		10/15						*
C* J. Ator/NCEP		03/20   Shorten check for "UNSPECIFIED" to just *
C*                              check for "UNSPEC", and check for all   *
C*                              blank characters                        *
C************************************************************************

	CHARACTER*(*)	string

	LOGICAL 	set2msg, allblks

C*-----------------------------------------------------------------------

	set2msg = .false.
        allblks = .true.

	lens = LEN ( string )

C*	Check for some unorthodox value in the string.

	IF ( ( INDEX ( string, 'UNKNOWN'     ) .ne. 0 ) .or.
     +	     ( INDEX ( string, 'UNSPEC'      ) .ne. 0 ) .or.
     + 	     ( INDEX ( string, '??????'      ) .ne. 0 ) ) THEN
	    set2msg = .true.
	ELSE
	    ii = 1
	    DO WHILE ( ( ii .le. lens ) .and. ( .not. set2msg ) )

C*		Check for the presence of a control character.  The
C*		following comparison works since character strings in
C*		BUFR, by definition, use the CCITT IA5 (i.e. ASCII)
C*		encoding scheme.

		IF ( string(ii:ii) .lt. ' ' ) THEN
		  set2msg = .true.
		ELSE
		  IF ( string(ii:ii) .ne. ' ' ) allblks = .false.
		  ii = ii + 1
		END IF
	    END DO
	END IF

C*      If the string hasn't already been flagged to be set to
C*      missing, and if it consists of all blank characters and is at
C*      least 6 characters long, then flag it.

        IF ( ( .not. set2msg ) .and. ( allblks ) .and. ( lens .ge. 6 ) )
     +      set2msg = .true.

	IF ( set2msg ) THEN

C*	    Set the string to BUFR "missing" by setting all bits to 1.

	    DO ii = 1, lens
		CALL IPKM ( string(ii:ii), 1, 255 )
	    END DO
	END IF

        RETURN
        END