gettbh.f

Go to the documentation of this file.

C> @file
C> @brief Read the header lines from a master table B, table D or
C> Code/Flag table
C>
C> @author J. Ator @date 2007-01-19
 
C> This subroutine reads the header lines from two separate ASCII
C> files (one standard and one local) containing master table B,
C> table D or Code/Flag table information.
C>
C> @param[in] LUNS   -- integer: Fortran logical unit number for
C>                      ASCII file containing standard table
C>                      information
C> @param[in] LUNL   -- integer: Fortran logical unit number for
C>                      ASCII file containing local table
C>                      information
C> @param[out] TAB   -- character: Type of table
C>                        - 'B' = Table B
C>                        - 'D' = Table D
C>                        - 'F' = Code/Flag table
C> @param[out] IMT   -- integer: Master table
C>                      - This value is read from both ASCII
C>                        files and must be identical between them.
C> @param[out] IMTV  -- integer: Version number of master table
C>                      - This value is read from the standard ASCII
C>                        file.
C> @param[out] IOGCE -- integer: Originating center
C>                      - This value is read from the local ASCII
C>                        file.
C> @param[out] ILTV  -- integer: Version number of local table
C>                      - This value is read from the local ASCII
C>                        file.
C>
C> @author J. Ator @date 2007-01-19
        SUBROUTINE gettbh ( LUNS, LUNL, TAB, IMT, IMTV, IOGCE, ILTV )
 
        CHARACTER*128   BORT_STR
        CHARACTER*40    HEADER
        CHARACTER*30    TAGS(5), LABEL
        CHARACTER*3     CFTYP
        CHARACTER*2     CTTYP
        CHARACTER*1     TAB
 
        LOGICAL BADLABEL
 
C-----------------------------------------------------------------------
C       Statement function to check for bad header line label:
 
        badlabel( label ) = ( ( index( label, cttyp ) .EQ. 0 ) .OR.
     .                         ( index( label, cftyp ) .EQ. 0 ) )
C-----------------------------------------------------------------------
 
        cttyp = tab // ' '
 
C       Read and parse the header line of the standard file.
 
        cftyp = 'STD'
        IF ( igetntbl( luns, header ) .NE. 0 ) GOTO 900
        CALL parstr ( header, tags, 5, ntag, '|', .false. )
        IF ( ntag .LT. 3 ) GOTO 900
        IF ( badlabel( tags(1) ) ) GOTO 900
        CALL strnum ( tags(2), imt, iersn )
        CALL strnum ( tags(3), imtv, iersn )
 
C       Read and parse the header line of the local file.
 
        cftyp = 'LOC'
        IF ( igetntbl( lunl, header ) .NE. 0 ) GOTO 900
        CALL parstr ( header, tags, 5, ntag, '|', .false. )
        IF ( ntag .LT. 4 ) GOTO 900
        IF ( badlabel( tags(1) ) ) GOTO 900
        CALL strnum ( tags(2), imt2, iersn )
        CALL strnum ( tags(3), iogce, iersn )
        CALL strnum ( tags(4), iltv, iersn )
 
C       Verify that both files are for the same master table.
 
        IF ( imt .NE. imt2 ) GOTO 901
 
        RETURN
 
 900    WRITE(bort_str,'("BUFRLIB: GETTBH - BAD OR MISSING HEADER '//
     .    'WITHIN ",A," TABLE ",A)') cftyp, tab
        CALL bort(bort_str)
 901    WRITE(bort_str,'("BUFRLIB: GETTBH - MASTER TABLE NUMBER '//
     .    'MISMATCH BETWEEN STD AND LOC TABLE ",A)') tab
        CALL bort(bort_str)
        END