NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
ishrdx.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Check whether two BUFR files are sharing the same DX BUFR
3 C> table.
4 
5 C> This function determines whether the same
6 C> [DX BUFR Table](@ref dfbftab) is being shared between two
7 C> Fortran logical units.
8 C>
9 C> @author J. Ator
10 C> @date 2009-06-18
11 C>
12 C> @param[in] LUD - integer: Internal I/O stream index associated
13 C> with first BUFR file
14 C> @param[in] LUN - integer: Internal I/O stream index associated
15 C> with second BUFR file
16 C> @returns ishrdx - integer: Flag indicating whether the same
17 C> DX BUFR table is being shared between the
18 C> BUFR file associated with LUD and the BUFR
19 C> file associated with LUN
20 C> - 0 = No
21 C> - 1 = Yes
22 C>
23 C> <b>Program history log:</b>
24 C> - 2009-06-18 J. Ator -- Original author
25 C> - 2014-12-10 J. Ator -- Use modules instead of COMMON blocks
26 C>
27  INTEGER FUNCTION ishrdx(LUD,LUN)
28 
29  USE moda_tababd
30 
31 C-----------------------------------------------------------------------
32 C-----------------------------------------------------------------------
33 
34 C Note that, for any I/O stream index value LUx, the MTAB(*,LUx)
35 C array contains pointer indices into the internal jump/link table
36 C for each of the Table A mnemonics that is currently defined for
37 C that LUx value. Thus, if all of these indices are identical for
38 C two different LUx values, then the associated logical units are
39 C sharing table information.
40 
41  IF ( ( ntba(lud) .GE. 1 ) .AND.
42  + ( ntba(lud) .EQ. ntba(lun) ) ) THEN
43  ii = 1
44  ishrdx = 1
45  DO WHILE ( ( ii .LE. ntba(lud) ) .AND. ( ishrdx .EQ. 1 ) )
46  IF ( ( mtab(ii,lud) .NE. 0 ) .AND.
47  + ( mtab(ii,lud) .EQ. mtab(ii,lun) ) ) THEN
48  ii = ii + 1
49  ELSE
50  ishrdx = 0
51  ENDIF
52  ENDDO
53  ELSE
54  ishrdx = 0
55  ENDIF
56 
57  RETURN
58  END
This module contains array and variable declarations used to store DX BUFR tables internally for mult...
Definition: moda_tababd.F:10
INTEGER function ishrdx(LUD, LUN)
This function determines whether the same DX BUFR Table is being shared between two Fortran logical u...
Definition: ishrdx.f:27