SUBROUTINE  BT_RPID ( mszrpt, report, lenrpt, iret )
C************************************************************************
C* BT_RPID                                                              *
C*                                                                      *
C* This subroutine decodes the the last section of the report.  It      *
C* contains the report ID, which is either a ship call sign or a buoy   *
C* ID.                                                                  *
C*                                                                      *
C* BT_RPID ( MSZRPT, REPORT, LENRPT, IRET )                             *
C*                                                                      *
C* Input parameters:                                                    *
C*      REPORT         CHAR*             Report array                   *
C*      MSZRPT         INTEGER           Report size in bytes           *
C*      IRPTYP         INTEGER           Report type identifier         *
C*                                       = 1, BATHY (JJYY) report       *
C*                                       = 2, TESAC (KKXX) report       *
C*                                       = 3, TRACKOB (NNXX) report     *
C*                                       = 4, BATHY (JJVV) report with  *
C*                                            a high precision lat/long *
C*                                       = 5, TESAC (KKYY) report with  *
C*                                            a high precision lat/long *
C*					                                *
C* Output parameters:                                                   *
C*      IDTYPE         INTEGER           Report ID type                 *
C*                                         0 = No ID                    *
C*                                         1 = Buoy ID                  *
C*                                         2 = Ship ID                  *
C*      LENRPT         INTEGER           Length of report minus sec 4   *
C*      CIVALS(ICSTID) CHAR*             Report ID                      *
C*      IRET           INTEGER           Return code                    *
C*                                         0 = Normal return            *
C*                                         1 = Problems                 *
C*                                         2 = Reject report            *
C*                                                                      *
C**                                                                     *
C* Log:                                                                 *
C* R. Hollern/NCEP      11/98                                           *
C* R. Hollern/NCEP      12/98   Corrected computation of new report     *
C*                              length                                  *
C* R. Hollern/NCEP       3/99   Removed the code to delete spaces at the*
C*                              end of report                           *
C* R. Hollern/NCEP       4/00   Removed code to save numeric buoy ID    *
C* R. Hollern/NCEP       8/00   Removed fld5 variable                   *
C************************************************************************
        INCLUDE 	'btcmn.cmn'
C*
        CHARACTER*(*)   report
C*
        CHARACTER       stnid*8,   chrstr*1
C*
        LOGICAL         more
C------------------------------------------------------------------------
        iret  = 0
        idtype = 0
        stnid = ' '
        ip = mszrpt
        lenrpt = mszrpt	
        icnt = 0
        more = .true.
C
C*      Check if report ends with a buoy ID.
C
        IF ( irptyp .eq. 1 .or. irptyp .eq. 4 ) THEN
            lpt = INDEX ( report, '8888' )
            ibl = 11
        ELSE IF ( irptyp .eq. 2 .or. irptyp .eq. 5 ) THEN
            lpt = INDEX ( report, ' 888' )
            ibl = 12
        END IF
C
        IF ( lpt .gt. 0 ) THEN
C
C*          Skip 99999 group if it follows the bathy report 8888k group
C*          or the tesac 888kk group.
C
            jpt = lpt + ibl
C
C*          The group 99999 precedes the buoy ID.
C
            lpt = INDEX ( report(jpt:mszrpt), '99999' )
C
            IF ( lpt .gt. 0 ) THEN
                idtype = 1
                mx = jpt + lpt + 5
                stnid(1:5) = report(mx:mx+4)
                civals (icstid ) = stnid
                lenrpt = mx - 7
                RETURN
            END IF
C
        END IF
C
C       Check if report ends with the ship's call sign.
C
        icnt = 0
        more = .true.
C
C*      Search backwards for the next space, which should be
C*      before the start of the report ID.
C
        DO WHILE ( more )
            IF ( report ( ip:ip ) .ne. ' ' ) THEN
                na = ip
                ip = ip - 1
                icnt = icnt + 1
              ELSE
                more = .false.
            END IF
C
            IF ( icnt .gt. 8 ) THEN
                ierrno = -5
                CALL BT_ERRS ( ierrno, report, iret )
                iret = 1
                RETURN
            END IF
C
        END DO
C
        IF ( icnt .gt. 0 ) THEN
            nb = na + icnt - 1
            stnid(1:icnt) = report(na:nb)
        END IF
C
        DO i = 1,icnt
C
C*          Check if character is numeric or alpha.  A ship ID
C*          contains at least one letter in the ID.
C
            chrstr = stnid(i:i)
C
            CALL ST_ALNM ( chrstr, ityp, mret )
C
            IF ( ityp .eq. 2 ) THEN
C
C*              Alpha character found.
C
                idtype = 2
            ELSE IF ( ityp .eq. 0 ) THEN
C
C*              Bad character in ID.
C
                ierrno = -5
                CALL BT_ERRS ( ierrno, report, iret )
                iret = 1
                RETURN
            END IF
        END DO
C
        IF ( idtype .eq. 2 ) THEN
            lenrpt = na - 1
            civals (icstid ) = stnid
        END IF 
C*
	RETURN
	END