NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
iok2cpy.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Check whether a BUFR message or data subset can be copied
3 C> from one BUFR file to another.
4 
5 C> This function determines whether a BUFR message, or a data subset
6 C> from within a BUFR message, can be copied from one Fortran logical
7 C> unit to another.
8 C>
9 C> <p>The decision is based on whether both logical units contain
10 C> identical definitions for the BUFR message type in question within
11 C> their associated [DX BUFR Table information](@ref dfbftab).
12 C> Note that it's possible for a BUFR message type to be identically
13 C> defined for two different logical units even if the full set of
14 C> associated DX BUFR table information isn't identical between both
15 C> units.
16 C>
17 C> @author J. Ator
18 C> @date 2009-06-26
19 C>
20 C> @param[in] LUI -- integer: Internal I/O stream index associated
21 C> with source BUFR file
22 C> @param[in] LUO -- integer: Internal I/O stream index associated
23 C> with target BUFR file
24 C> @returns iok2cpy -- integer: Flag indicating whether a BUFR
25 C> message or data subset can be copied from the
26 C> BUFR file associated with LUI to the BUFR file
27 C> associated with LUO
28 C> - 0 = No
29 C> - 1 = Yes
30 C>
31 C> <b>Program history log:</b>
32 C> | Date | Programmer | Comments |
33 C> | -----|------------|----------|
34 C> | 2009-06-26 | J. Ator | Original author |
35 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
36 C>
37  INTEGER FUNCTION iok2cpy(LUI,LUO)
38 
39  USE moda_msgcwd
40  USE moda_tables
41 
42  CHARACTER*8 subset
43 
44 C-----------------------------------------------------------------------
45 C-----------------------------------------------------------------------
46 
47  iok2cpy = 0
48 
49 C Do both logical units have the same internal table information?
50 
51  IF ( icmpdx(lui,luo) .EQ. 1 ) THEN
52  iok2cpy = 1
53  RETURN
54  ENDIF
55 
56 C No, so get the Table A mnemonic from the message to be copied,
57 C then check whether that mnemonic is defined within the dictionary
58 C tables for the logical unit to be copied to.
59 
60  subset = tag(inode(lui))
61  CALL nemtbax(luo,subset,mtyp,msbt,inod)
62  IF ( inod .EQ. 0 ) RETURN
63 
64 C The Table A mnemonic is defined within the dictionary tables for
65 C both units, so now make sure the definitions are identical.
66 
67  ntei = isc(inode(lui))-inode(lui)
68  nteo = isc(inod)-inod
69  IF ( ntei .NE. nteo ) RETURN
70 
71  DO i = 1, ntei
72  IF ( tag(inode(lui)+i) .NE. tag(inod+i) ) RETURN
73  IF ( typ(inode(lui)+i) .NE. typ(inod+i) ) RETURN
74  IF ( isc(inode(lui)+i) .NE. isc(inod+i) ) RETURN
75  IF ( irf(inode(lui)+i) .NE. irf(inod+i) ) RETURN
76  IF ( ibt(inode(lui)+i) .NE. ibt(inod+i) ) RETURN
77  ENDDO
78 
79  iok2cpy = 1
80 
81  RETURN
82  END
subroutine nemtbax(LUN, NEMO, MTYP, MSBT, INOD)
This subroutine searches for a descriptor within Table A of the internal DX BUFR tables.
Definition: nemtbax.f:33
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13
INTEGER function iok2cpy(LUI, LUO)
This function determines whether a BUFR message, or a data subset from within a BUFR message...
Definition: iok2cpy.f:37
INTEGER function icmpdx(LUD, LUN)
This function determines whether the full set of associated DX BUFR Table information is identical be...
Definition: icmpdx.f:33