lcmgdf.f

Go to the documentation of this file.

C> @file
C> @brief Check for the existence of any long character strings
C> (greater than 8 bytes) within a data subset definition.

C> This function checks whether the subset definition for a given
C> message type contains any long character strings (greater
C> than 8 bytes).
C>
C> @author J. Ator
C> @date 2009-07-09
C>
C> @param[in] LUNIT  - integer: Fortran logical unit number for
C>                     BUFR file
C> @param[in] SUBSET - character*8: Table A mnemonic of message
C>                     type to be checked
C> @returns lcmgdf - integer: 
C>                    -  0 = SUBSET does not contain any long
C>                           character strings
C>                    -  1 = SUBSET contains at least one long
C>                           character string
C>
C> @remarks
C> - LUNIT may be open for either input or output operations via a
C> previous call to subroutine openbf().  However, in either case,
C> SUBSET must already be defined within the BUFR tables that are
C> associated with LUNIT, typically as [DX BUFR tables](@ref dfbftab)
C> information supplied via argument LUNDX when openbf() was called,
C> or, if openbf() was called with IO = 'SEC3', then as
C> [master BUFR table](@ref dfbfmstab) information during a previous
C> call to one of the [message-reading subroutines](@ref hierarchy).
C> - Note that this function does not return mnemonic(s) associated
C> with any long character string(s) found within SUBSET; rather,
C> it only checks whether at least one such mnemonic exists.  If any
C> are found, the application program can process them via a
C> separate call to subroutine readlc() (when reading BUFR data
C> subsets) or subroutine writlc() (when writing BUFR data subsets).
C>
C> <b>Program history log:</b>
C> - 2009-07-09  J. Ator    -- Original author
C> - 2014-12-10  J. Ator    -- Use modules instead of COMMON blocks
C>
      INTEGER FUNCTION lcmgdf(LUNIT,SUBSET)

      USE moda_tables

      CHARACTER*8  subset

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

C     Get LUN from LUNIT.

      CALL status(lunit,lun,il,im)
      IF (il.EQ.0) goto 900
 
C     Confirm that SUBSET is defined for this logical unit.

      CALL nemtba(lun,subset,mtyp,msbt,inod)

C     Check if there's a long character string in the definition.

      nte = isc(inod)-inod

      DO i = 1, nte
        IF ( (typ(inod+i).EQ.'CHR') .AND. (ibt(inod+i).GT.64) ) THEN
          lcmgdf = 1
          RETURN
        ENDIF
      ENDDO

      lcmgdf = 0

      RETURN
900   CALL bort('BUFRLIB: LCMGDF - INPUT BUFR FILE IS CLOSED, IT MUST'//
     . ' BE OPEN')
      END