icmpdx.f

Go to the documentation of this file.

C> @file
C> @brief Check whether two BUFR files have the same DX BUFR table
C> information.

C> This function determines whether the full set of associated
C> [DX BUFR Table information](@ref dfbftab) is identical between
C> two Fortran logical units.
C>
C> Note that two different logical units can have identical DX BUFR
C> Table information associated with them even if they aren't actually
C> sharing the same DX BUFR table.
C>
C> @author J. Ator
C> @date 2009-06-18
C>
C> @param[in]  LUD      - integer: Internal I/O stream index associated
C>                        with first BUFR file
C> @param[in]  LUN      - integer: Internal I/O stream index associated
C>                        with second BUFR file
C> @returns icmpdx      - integer: Flag indicating whether the 
C>                        BUFR file associated with LUD and the BUFR
C>                        file associated with LUN have the same DX
C>                        BUFR table information
C>                        - 0 = No
C>                        - 1 = Yes
C>
C> <b>Program history log:</b>
C> - 2009-06-18  J. Ator    -- Original author
C> - 2014-12-10  J. Ator    -- Use modules instead of COMMON blocks
C>
      INTEGER FUNCTION icmpdx(LUD,LUN)

      USE moda_tababd

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

C     First, check whether the two units are actually sharing tables.
C     If so, then they obviously have the same table information.

      icmpdx = ishrdx(lud,lun)
      IF ( icmpdx .EQ. 1 ) RETURN

C     Otherwise, check whether the internal Table A, B and D entries are
C     all identical between the two units.

      IF ( ( ntba(lud) .EQ. 0 ) .OR.
     .      ( ntba(lun) .NE. ntba(lud) ) ) RETURN
      DO i = 1, ntba(lud)
    IF ( idna(i,lun,1) .NE. idna(i,lud,1) ) RETURN
    IF ( idna(i,lun,2) .NE. idna(i,lud,2) ) RETURN
    IF ( taba(i,lun) .NE. taba(i,lud) ) RETURN
      ENDDO

    IF ( ( ntbb(lud) .EQ. 0 ) .OR.
     .      ( ntbb(lun) .NE. ntbb(lud) ) ) RETURN
      DO i = 1, ntbb(lud)
    IF ( idnb(i,lun) .NE. idnb(i,lud) ) RETURN
    IF ( tabb(i,lun) .NE. tabb(i,lud) ) RETURN
      ENDDO

      IF ( ( ntbd(lud) .EQ. 0 ) .OR.
     .      ( ntbd(lun) .NE. ntbd(lud) ) ) RETURN
      DO i = 1, ntbd(lud)
    IF ( idnd(i,lun) .NE. idnd(i,lud) ) RETURN
    IF ( tabd(i,lun) .NE. tabd(i,lud) ) RETURN
      ENDDO

      icmpdx = 1

      RETURN
      END