SUBROUTINE LS_BTYP ( lenb, bulltn, jpos, yyggi, iret ) C************************************************************************ C* LS_BTYP * C* * C* This subroutine checks that the bulletin contains fixed land station * C* or mobil land station reports. If the bulletin contains the ID * C* letters OOXX after the bulletin header, then the bulletin contains * C* mobil land station reports. If the AAXX ID letters follow the * C* bulletin header, then the bulletin contains fixed land station * C* reports. If the AAXX yyggi line is missing and it is determined that * C* the bulletin contains fixed land station reports, then the date/time * C* data group yyggi is built from the bulletin header data. * C* * C* LS_BTYP ( LENB, BULLTN, JPOS, YYGGI, IRET ) * C* * C* Input parameters: * C* LENB INTEGER Bulletin length * C* BULLTN CHAR* Bulletin to decode * C* * C* Output parameters: * C* IBRTYP INTEGER Bulletin FM code form * C* 1 = FM 12 synoptic land * C* 2 = FM 14 synoptic mobil * C* JPOS INTEGER Pointer to ID in report * C* YYGGI CHAR* YYGGi(w) data group in land * C* synoptic bulletin * C* IRET INTEGER Return code * C* =0, normal return * C* * C** * C* Log: * C* R. Hollern/NCEP 4/96 * C* R. Hollern/NCEP 1/98 Cleaned up and improved logging * C* A. Hardy/GSC 1/98 Added GEMINC, cleaned up * C* R. Hollern/NCEP 7/02 Renamed iaaxx to yyggi * C* R. Hollern/NCEP 8/02 Added code to check if mobil report * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' C* CHARACTER*(*) bulltn, yyggi C* CHARACTER chrstr*1 LOGICAL again C------------------------------------------------------------------------ ibrtyp = 0 iret = 0 again = .true. C C* Check if OOXX ID letters follow bulletin header. C ipos = index( bulltn ( 1:50 ), 'OOXX' ) C IF ( ipos .gt. 0 ) THEN jpos = ipos + 5 ibrtyp = 2 RETURN END IF C C* Check if AAXX ID letters follow bulletin header. C ipos = index( bulltn ( 1:50 ), 'AAXX' ) C IF ( ipos .gt. 0 .and. bulltn (ipos+10:ipos+10) .eq. ' ' ) THEN jpos = ipos + 10 C C* Check that the ID is a block/station number. C chrstr = bulltn ( jpos+1:jpos+1 ) C CALL ST_ALNM ( chrstr, mtyp, ier ) IF ( mtyp .ne. 1 ) RETURN C jpos = ipos + 10 ibrtyp = 1 yyggi = bulltn ( ipos+5:ipos+9 ) RETURN END IF C C* Check if bulletin contains marine reports. C ipos = index ( bulltn ( 1:50 ), 'BBXX' ) IF ( ipos .gt. 0 ) THEN CALL DC_WLOG ( 4, 'DCLSFC ', -9, bulltn (1:40), ier ) RETURN END IF C C* Check if bulletin contains METAR reports. C ipos = index ( bulltn ( 1:50 ), 'METAR' ) IF ( ipos .gt. 0 ) RETURN C C* Try to construct AAXX line. C ipos = INDEX ( bulltn ( 1:50 ), btime ( 1:6 ) ) C IF ( ipos .eq. 0 ) THEN RETURN ELSE jpos = ipos END IF C IF ( bbb ( 1:1 ) .ne. ' ' ) THEN ipos = INDEX ( bulltn ( 1:50 ), bbb ( 1:3 ) ) IF ( ipos .eq. 0 ) THEN RETURN ELSE jpos = ipos END IF END IF C again = .true. C C* Find the blank before start of station ID. C DO WHILE ( again ) IF ( jpos .gt. 70 ) THEN RETURN ELSE jpos = jpos + 1 IF ( bulltn ( jpos:jpos ) .eq. ' ' ) THEN again = .false. END IF END IF END DO C C* Check that the ID is a block/station number. C chrstr = bulltn ( jpos+1:jpos+1 ) C CALL ST_ALNM ( chrstr, mtyp, ier ) IF ( mtyp .ne. 1 ) RETURN C ibrtyp = 1 yyggi ( 1:4 ) = btime ( 1:4 ) yyggi ( 5:5 ) = '9' C* RETURN END