<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='LCMGDF'><A href='../../html_code/bufr/lcmgdf.f.html#LCMGDF' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
INTEGER FUNCTION LCMGDF(LUNIT,SUBSET),3
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: LCMGDF
C PRGMMR: J. ATOR ORG: NP20 DATE: 2009-07-09
C
C ABSTRACT: THIS FUNCTION CHECKS WHETHER AT LEAST ONE "LONG" (I.E.
C GREATER THAN 8 BYTES) CHARACTER STRING EXISTS WITHIN THE INTERNAL
C DICTIONARY DEFINITION FOR THE TABLE A MESSAGE TYPE GIVEN BY SUBSET.
C
C PROGRAM HISTORY LOG:
C 2009-07-09 J. ATOR -- ORIGINAL AUTHOR
C
C USAGE: LCMGDF (LUNIT, SUBSET)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER ASSOCIATED WITH
C SUBSET DEFINITION
C SUBSET - CHARACTER*8: TABLE A MNEMONIC FOR MESSAGE TYPE
C
C OUTPUT ARGUMENT LIST:
C LCMGDF - INTEGER: RETURN CODE INDICATING WHETHER SUBSET CONTAINS
C AT LEAST ONE "LONG" CHARACTER STRING IN ITS DEFINITION
C 0 - NO
C 1 - YES
C
C REMARKS:
C THIS ROUTINE CALLS: BORT NEMTBA STATUS
C THIS ROUTINE IS CALLED BY: None
C Normally called only by application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL),
. JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL),
. IBT(MAXJL),IRF(MAXJL),ISC(MAXJL),
. ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL),
. ISEQ(MAXJL,2),JSEQ(MAXJL)
CHARACTER*10 TAG
CHARACTER*8 SUBSET
CHARACTER*3 TYP
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