rdmtbb.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2007-01-19
    
C> THIS SUBROUTINE READS MASTER TABLE B INFORMATION FROM TWO
C>   SEPARATE (I.E. ONE STANDARD AND ONE LOCAL) ASCII FILES AND THEN
C>   MERGES IT INTO A UNIFIED SET OF MASTER TABLE B ARRAYS FOR OUTPUT.
C>   EACH OF THE TWO INPUT FILES MUST ALREADY BE INDIVIDUALLY SORTED IN
C>   ASCENDING ORDER WITH RESPECT TO THE FXY NUMBERS.
C>
C> PROGRAM HISTORY LOG:
C> 2007-01-19  J. ATOR    -- ORIGINAL AUTHOR
C> 2021-01-08  J. ATOR    -- MODIFIED MSTABS ARRAY DECLARATIONS
C>                           FOR GNUv10 PORTABILITY
C>
C> USAGE:    CALL RDMTBB ( LUNSTB, LUNLTB, MXMTBB, IMT, IMTV, IOGCE,
C>                         ILTV, NMTBB, IMFXYN, CMSCL, CMSREF, CMBW,
C>                         CMUNIT, CMMNEM, CMDSC, CMELEM )
C>   INPUT ARGUMENT LIST:
C>     LUNSTB   - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
C>                CONTAINING STANDARD TABLE B INFORMATION
C>     LUNLTB   - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
C>                CONTAINING LOCAL TABLE B INFORMATION
C>     MXMTBB   - INTEGER: MAXIMUM NUMBER OF ENTRIES TO BE STORED IN
C>                MERGED MASTER TABLE B ARRAYS; THIS SHOULD BE THE SAME
C>                NUMBER AS WAS USED TO DIMENSION THE OUTPUT ARRAYS IN
C>                THE CALLING PROGRAM, AND IT IS USED BY THIS SUBROUTINE
C>                TO ENSURE THAT IT DOESN'T OVERFLOW THESE ARRAYS
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>     NMTBB    - INTEGER: NUMBER OF ENTRIES IN MERGED MASTER TABLE B
C>                ARRAYS
C>     IMFXYN(*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
C>                REPRESENTATIONS OF FXY NUMBERS
C>     CMSCL(*) - CHARACTER*4: MERGED ARRAY CONTAINING SCALE FACTORS
C>     CMSREF(*)- CHARACTER*12: MERGED ARRAY CONTAINING REFERENCE VALUES
C>     CMBW(*)  - CHARACTER*4: MERGED ARRAY CONTAINING BIT WIDTHS
C>     CMUNIT(*)- CHARACTER*14: MERGED ARRAY CONTAINING UNITS
C>     CMMNEM(*)- CHARACTER*8: MERGED ARRAY CONTAINING MNEMONICS
C>     CMDSC(*) - CHARACTER*4: MERGED ARRAY CONTAINING DESCRIPTOR CODES 
C>     CMELEM(*)- CHARACTER*120: MERGED ARRAY CONTAINING ELEMENT NAMES 
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        ADN30    BORT     GETNTBE  GETTBH
C>                               SNTBBE   WRDLEN
C>    THIS ROUTINE IS CALLED BY: IREADMT
C>                               Not normally called by any application
C>                               programs but it could be.
C>
    SUBROUTINE rdmtbb ( LUNSTB, LUNLTB, MXMTBB,
     .              imt, imtv, iogce, iltv,
     .              nmtbb, imfxyn, cmscl, cmsref, cmbw,
     .              cmunit, cmmnem, cmdsc, cmelem )



    character*200   stline, ltline
    character*128   bort_str
    character*6 cmatch, adn30
    character*4 cmdsc(*)
    character   cmelem(120,*)
    character   cmunit(14,*)
    character   cmsref(12,*)
    character   cmmnem(8,*)
    character   cmscl(4,*), cmbw(4,*)

    integer     imfxyn(*)

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   Read and parse the header lines of both files.

    CALL gettbh( lunstb, lunltb, 'B', imt, imtv, iogce, iltv )
    
C   Read through the remainder of both files, merging the
C   contents into a unified set of master Table B arrays.

    nmtbb = 0
    CALL getntbe( lunstb, isfxyn, stline, iers )
    CALL getntbe( lunltb, 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 sntbbe( isfxyn, stline, mxmtbb,
     .              nmtbb, imfxyn, cmscl, cmsref, cmbw,
     .              cmunit, cmmnem, cmdsc, cmelem )
          CALL getntbe( lunstb, isfxyn, stline, iers )
        ELSE
          CALL sntbbe( ilfxyn, ltline, mxmtbb,
     .              nmtbb, imfxyn, cmscl, cmsref, cmbw,
     .              cmunit, cmmnem, cmdsc, cmelem )
          CALL getntbe( lunltb, ilfxyn, ltline, ierl )
        ENDIF
      ELSE IF ( iers .EQ. 0 ) THEN
        CALL sntbbe( isfxyn, stline, mxmtbb,
     .            nmtbb, imfxyn, cmscl, cmsref, cmbw,
     .            cmunit, cmmnem, cmdsc, cmelem )
        CALL getntbe( lunstb, isfxyn, stline, iers )
      ELSE IF ( ierl .EQ. 0 ) THEN
        CALL sntbbe( ilfxyn, ltline, mxmtbb,
     .            nmtbb, imfxyn, cmscl, cmsref, cmbw,
     .            cmunit, cmmnem, cmdsc, cmelem )
        CALL getntbe( lunltb, ilfxyn, ltline, ierl )
      ENDIF
    ENDDO

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