rdmtbf.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2017-10-17
    
C> THIS SUBROUTINE READS MASTER CODE/FLAG TABLE INFORMATION
C>   FROM TWO SEPARATE (I.E. ONE STANDARD AND ONE LOCAL) ASCII FILES
C>   AND THEN MERGES IT INTO AN INTERNAL MEMORY STRUCTURE.  EACH OF THE
C>   TWO INPUT FILES MUST ALREADY BE INDIVIDUALLY SORTED IN ASCENDING
C>   ORDER WITH RESPECT TO THE FXY NUMBERS.
C>
C> PROGRAM HISTORY LOG:
C> 2017-10-17  J. ATOR    -- ORIGINAL AUTHOR
C>
C> USAGE:    CALL RDMTBF ( LUNSTF, LUNLTF )
C>
C>   INPUT ARGUMENT LIST:
C>     LUNSTF   - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
C>                CONTAINING STANDARD CODE/FLAG TABLE INFORMATION
C>     LUNLTF   - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
C>                CONTAINING LOCAL CODE/FLAG TABLE INFORMATION
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        ADN30    BORT     GETNTBE  GETTBH
C>                               INITTBF  SNTBFE   SORTTBF  WRDLEN
C>    THIS ROUTINE IS CALLED BY: IREADMT
C>                               Not normally called by any application
C>                               programs.
C>
    SUBROUTINE rdmtbf ( LUNSTF, LUNLTF )



    character*160   stline, ltline
    character*128   bort_str
    character*6 cmatch, adn30

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

C   Call WRDLEN to initialize some important information about the
C   local machine, just in case it hasn't already been called.

    CALL wrdlen

C   Initialize the internal memory structure, including allocating
C   space for it in case this hasn't already been done.

    CALL inittbf

C   Read and parse the header lines of both files.

    CALL gettbh( lunstf, lunltf, 'F', imt, imtv, iogce, iltv )
    
C   Read through the remainder of both files, merging the
C   contents into a unified internal memory structure.

    CALL getntbe( lunstf, isfxyn, stline, iers )
    CALL getntbe( lunltf, ilfxyn, ltline, ierl )
    DO WHILE ( ( iers .EQ. 0 ) .OR. ( ierl .EQ. 0 ) )
      IF ( ( iers .EQ. 0 ) .AND. ( ierl .EQ. 0 ) ) THEN
        IF ( isfxyn .EQ. ilfxyn ) THEN
          cmatch = adn30( isfxyn, 6 )
          goto 900
        ELSE IF ( isfxyn .LT. ilfxyn ) THEN
          CALL sntbfe( lunstf, isfxyn, stline )
          CALL getntbe( lunstf, isfxyn, stline, iers )
        ELSE
          CALL sntbfe( lunltf, ilfxyn, ltline )
          CALL getntbe( lunltf, ilfxyn, ltline, ierl )
        ENDIF
      ELSE IF ( iers .EQ. 0 ) THEN
        CALL sntbfe( lunstf, isfxyn, stline )
        CALL getntbe( lunstf, isfxyn, stline, iers )
      ELSE IF ( ierl .EQ. 0 ) THEN
        CALL sntbfe( lunltf, ilfxyn, ltline )
        CALL getntbe( lunltf, ilfxyn, ltline, ierl )
      ENDIF
    ENDDO

C   Sort the contents of the internal memory structure.

    CALL sorttbf

    RETURN
 900    WRITE(bort_str,'("BUFRLIB: RDMTBF - STANDARD AND LOCAL'//
     . ' CODE/FLAG TABLE FILES BOTH CONTAIN SAME FXY NUMBER: ",5A)')
     .   cmatch(1:1), '-', cmatch(2:3), '-', cmatch(4:6)    
    CALL bort(bort_str)
    END