SUBROUTINE UA_ZRCK ( iret )
C************************************************************************
C* UA_ZRCK *
C* *
C* This subroutine checks whether an excessive amount (i.e. 75% or more)*
C* of the decoded mandatory level heights within a report are multiples *
C* of 1000, meaning that these heights were encoded as "000" and thus *
C* that the report itself was improperly transmitted. If so, then all *
C* multi-level data for the report is deleted. *
C* *
C* UA_ZRCK ( IRET ) *
C* *
C* Output parameters: *
C* IRET INTEGER Return code: *
C* 0 = normal return *
C* *
C** *
C* Log: *
C* J. Ator/NCEP 12/98 *
C* J. Ator/NCEP 10/99 Clean up function declarations *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'uacmn.cmn'
C------------------------------------------------------------------------
C
C* Initialize variables.
C
iret = 0
nmlv = 0
nzmlv = 0
C
nlev = INT ( rivals ( irnlev ) )
C
C* Make sure that NLEV > 0
C
IF ( nlev .le. 0 ) THEN
RETURN
END IF
C
DO jj = 1, nlev
C
C* Is this level a mandatory level?
C
IF ( INT ( rivals ( irvsig ( jj ) ) ) .eq. 32 ) THEN
C
nmlv = nmlv + 1
C
C* Is the decoded height at this level a multiple of 1000?
C
ihgtm = INT ( rivals ( irhgtm ( jj ) ) )
IF ( MOD ( ihgtm, 1000 ) .eq. 0 ) THEN
nzmlv = nzmlv + 1
END IF
END IF
END DO
C
IF ( nmlv .ge. 4 ) THEN
C
C* Determine how often the decoded height was a multiple
C* of 1000. If this occurred for at least 75% of the
C* mandatory levels, then delete all multi-level data for
C* the report.
C
pct000 = FLOAT ( nzmlv ) * 100.0 / FLOAT ( nmlv )
IF ( pct000 .gt. 74.5 ) THEN
WRITE ( UNIT = logmsg, FMT = '( I2, A, I2, A )' )
+ nzmlv, ' of ', nmlv, ' manlev heights were 000'
CALL DC_WLOG ( 2, 'UA', 2, logmsg, ierwlg )
CALL UA_RDCS ( 119, ierrdc )
rivals ( irnlev ) = 0
END IF
END IF
C*
RETURN
END