var/external/bufr/gettbh.f

   1         SUBROUTINE GETTBH ( LUNS, LUNL, TAB, IMT, IMTV, IOGCE, ILTV )
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    GETTBH
   6 C   PRGMMR: ATOR            ORG: NP12       DATE: 2007-01-19
   7 C
   8 C ABSTRACT:  THIS SUBROUTINE READS AND PARSES THE HEADER LINES FROM TWO
   9 C   SEPARATE (I.E. ONE STANDARD AND ONE LOCAL) ASCII FILES CONTAINING
  10 C   EITHER MASTER TABLE B OR MASTER TABLE D INFORMATION.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C 2007-01-19  J. ATOR    -- ORIGINAL AUTHOR
  14 C
  15 C USAGE:    CALL GETTBH ( LUNS, LUNL, TAB, IMT, IMTV, IOGCE, ILTV )
  16 C
  17 C   INPUT ARGUMENT LIST:
  18 C     LUNS     - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
  19 C                CONTAINING STANDARD TABLE INFORMATION
  20 C     LUNL     - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
  21 C                CONTAINING LOCAL TABLE INFORMATION
  22 C     TAB      - CHARACTER*1: TABLE TYPE ('B' OR 'D')
  23 C
  24 C   OUTPUT ARGUMENT LIST:
  25 C     IMT      - INTEGER: MASTER TABLE, READ FROM EACH ASCII FILE
  26 C                (NOTE: THESE VALUES MUST BE THE SAME IN EACH FILE!)
  27 C     IMTV     - INTEGER: VERSION NUMBER OF MASTER TABLE, READ FROM
  28 C                STANDARD ASCII FILE
  29 C     IOGCE    - INTEGER: ORIGINATING CENTER, READ FROM LOCAL ASCII FILE
  30 C     ILTV     - INTEGER: VERSION NUMBER OF LOCAL TABLE, READ FROM
  31 C                LOCAL ASCII FILE
  32 C
  33 C REMARKS:
  34 C    THIS ROUTINE CALLS:        BORT     IGETNTBL PARSTR   VALX
  35 C    THIS ROUTINE IS CALLED BY: RDMTBB   RDMTBD
  36 C                               Also called by application programs.
  37 C
  38 C ATTRIBUTES:
  39 C   LANGUAGE: FORTRAN 77
  40 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  41 C
  42 C$$$
  43
  44         CHARACTER*128   BORT_STR
  45         CHARACTER*40    HEADER
  46         CHARACTER*30    TAGS(5), LABEL
  47         CHARACTER*3     CFTYP
  48         CHARACTER*2     CTTYP
  49         CHARACTER*1     TAB
  50
  51         LOGICAL BADLABEL
  52
  53 C-----------------------------------------------------------------------
  54 C       Statement function to check for bad header line label:
  55
  56         BADLABEL ( LABEL ) = ( ( INDEX ( LABEL, CTTYP ) .EQ. 0 ) .OR.
  57      .                         ( INDEX ( LABEL, CFTYP ) .EQ. 0 ) )
  58 C-----------------------------------------------------------------------
  59
  60         CTTYP = TAB // ' '
  61
  62 C       Read and parse the header line of the standard file.
  63
  64         CFTYP = 'STD'
  65         IF ( IGETNTBL ( LUNS, HEADER ) .NE. 0 ) GOTO 900
  66         CALL PARSTR ( HEADER, TAGS, 5, NTAG, '|', .FALSE. )
  67         IF ( NTAG .LT. 3 ) GOTO 900
  68         IF ( BADLABEL ( TAGS(1) ) ) GOTO 900
  69         IMT = VALX ( TAGS(2) )
  70         IMTV = VALX ( TAGS(3) )
  71
  72 C       Read and parse the header line of the local file.
  73
  74         CFTYP = 'LOC'
  75         IF ( IGETNTBL ( LUNL, HEADER ) .NE. 0 ) GOTO 900
  76         CALL PARSTR ( HEADER, TAGS, 5, NTAG, '|', .FALSE. )
  77         IF ( NTAG .LT. 4 ) GOTO 900
  78         IF ( BADLABEL ( TAGS(1) ) ) GOTO 900
  79         IMT2 = VALX ( TAGS(2) )
  80         IOGCE = VALX ( TAGS(3) )
  81         ILTV = VALX ( TAGS(4) )
  82
  83 C       Verify that both files are for the same master table.
  84
  85         IF ( IMT .NE. IMT2 ) GOTO 901
  86
  87         RETURN
  88
  89  900    WRITE(BORT_STR,'("BUFRLIB: GETTBH - BAD OR MISSING HEADER '//
  90      .    'WITHIN ",A," TABLE ",A)') CFTYP, TAB
  91         CALL BORT(BORT_STR)
  92  901    WRITE(BORT_STR,'("BUFRLIB: GETTBH - MASTER TABLE NUMBER '//
  93      .    'MISMATCH BETWEEN STD AND LOC TABLE ",A)') TAB
  94         CALL BORT(BORT_STR)
  95         END