iok2cpy.f

Go to the documentation of this file.

C> @file
C> @brief Check whether a BUFR message or data subset can be copied
C> from one BUFR file to another.
C>
C> @author J. Ator @date 2009-06-26
 
C> This function determines whether a BUFR message, or a data subset
C> from within a BUFR message, can be copied from one Fortran logical
C> unit to another.
C>
C> The decision is based on whether both logical units contain
C> identical definitions for the BUFR message type in question within
C> their associated [DX BUFR Table information](@ref dfbftab).
C> Note that it's possible for a BUFR message type to be identically
C> defined for two different logical units even if the full set of
C> associated DX BUFR table information isn't identical between both
C> units.
C>
C> @param[in]  LUI  - integer: File ID for source BUFR file
C> @param[in]  LUO  - integer: File ID for target BUFR file
C> @returns iok2cpy - integer: Flag indicating whether a BUFR message
C> or data subset can be copied from LUI to LUO
C> - 0 = No
C> - 1 = Yes
C>
C> @author J. Ator @date 2009-06-26
      INTEGER FUNCTION iok2cpy(LUI,LUO)
 
      USE moda_msgcwd
      USE moda_tables
 
      CHARACTER*8  subset
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
      iok2cpy = 0
 
C     Do both logical units have the same internal table information?
 
      IF ( icmpdx(lui,luo) .EQ. 1 ) THEN
        iok2cpy = 1
        RETURN
      ENDIF
 
C     No, so get the Table A mnemonic from the message to be copied,
C     then check whether that mnemonic is defined within the dictionary
C     tables for the logical unit to be copied to.
 
      subset = tag(inode(lui))(1:8)
      CALL nemtbax(luo,subset,mtyp,msbt,inod)
      IF ( inod .EQ. 0 ) RETURN
 
C     The Table A mnemonic is defined within the dictionary tables for
C     both units, so now make sure the definitions are identical.
 
      ntei = isc(inode(lui))-inode(lui)
      nteo = isc(inod)-inod
      IF ( ntei .NE. nteo ) RETURN
 
      DO i = 1, ntei
        IF ( tag(inode(lui)+i) .NE. tag(inod+i) ) RETURN
        IF ( typ(inode(lui)+i) .NE. typ(inod+i) ) RETURN
        IF ( isc(inode(lui)+i) .NE. isc(inod+i) ) RETURN
        IF ( irf(inode(lui)+i) .NE. irf(inod+i) ) RETURN
        IF ( ibt(inode(lui)+i) .NE. ibt(inod+i) ) RETURN
      ENDDO
 
      iok2cpy = 1
 
      RETURN
      END