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>
C> @author J. Ator @date 2009-06-18
 
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> @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> @author J. Ator @date 2009-06-18
      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