gettbh.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2007-01-19
    
C> THIS SUBROUTINE READS AND PARSES THE HEADER LINES FROM TWO
C>   SEPARATE (I.E. ONE STANDARD AND ONE LOCAL) ASCII FILES CONTAINING
C>   EITHER MASTER TABLE B OR MASTER TABLE D INFORMATION.
C>
C> PROGRAM HISTORY LOG:
C> 2007-01-19  J. ATOR    -- ORIGINAL AUTHOR
C>
C> USAGE:    CALL GETTBH ( LUNS, LUNL, TAB, IMT, IMTV, IOGCE, ILTV )
C>
C>   INPUT ARGUMENT LIST:
C>     LUNS     - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
C>                CONTAINING STANDARD TABLE INFORMATION
C>     LUNL     - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
C>                CONTAINING LOCAL TABLE INFORMATION
C>     TAB      - CHARACTER*1: TABLE TYPE ('B' OR 'D')
C>
C>   OUTPUT ARGUMENT LIST:
C>     IMT      - INTEGER: MASTER TABLE, READ FROM EACH ASCII FILE
C>                (NOTE: THESE VALUES MUST BE THE SAME IN EACH FILE!)
C>     IMTV     - INTEGER: VERSION NUMBER OF MASTER TABLE, READ FROM
C>                STANDARD ASCII FILE
C>     IOGCE    - INTEGER: ORIGINATING CENTER, READ FROM LOCAL ASCII FILE
C>     ILTV     - INTEGER: VERSION NUMBER OF LOCAL TABLE, READ FROM
C>                LOCAL ASCII FILE
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        BORT     IGETNTBL PARSTR   VALX
C>    THIS ROUTINE IS CALLED BY: RDMTBB   RDMTBD   RDMTBF
C>                               Also called by application programs.
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