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> 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> @author J. Ator
C> @date 2007-01-19
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> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2007-01-19 | J. Ator | Original author |
C>
    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
    imt = valx( tags(2) )
    imtv = valx( tags(3) )
    
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
    imt2 = valx( tags(2) )
    iogce = valx( tags(3) )
    iltv = valx( tags(4) )
    
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