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