getcfmng.f

Go to the documentation of this file.

C> @file
C> @brief Decode the meaning of a numerical value from a code or flag table
 
C> This subroutine searches for a specified Table B mnemonic and associated
C> value (code figure or bit number) within the master Code/Flag tables,
C> and if found returns the associated meaning as a character string.
C>
C> @author J. Ator
C> @date 2018-01-11
C>
C> @param[in]  LUNIT   -- integer: Fortran logical unit number for
C>                        BUFR file
C> @param[in]  NEMOI   -- character*(*): Mnemonic to search for
C> @param[in]  IVALI   -- integer: Value (code figure or bit number)
C>                        associated with NEMOI
C> @param[in]  NEMOD   -- character*(*): Optional second mnemonic upon
C>                        which the values NEMOI and IVALI depend; set to
C>                        all blank characters if the meanings of NEMOI and
C>                        IVALI do not depend on the value of any other
C>                        mnemonic
C> @param[in]  IVALD   -- integer: Value (code figure or bit number)
C>                        associated with NEMOD; set to (-1) whenever
C>                        NEMOD is set to all blank characters
C> @param[out] CMEANG  -- character*(*): If the initial search of the
C>                        master Code/Flag tables was successful, then this
C>                        string contains the meaning corresponding to NEMOI
C>                        and IVALI (and to NEMOD and IVALD, if specified).
C>                        However, if the initial search was unsuccessful,
C>                        <b>and</b> if no optional second mnemonic and
C>                        associated value were specified on input,
C>                        <b>and</b> if a second search of the table
C>                        determines that the meaning of NEMOI and IVALI
C>                        indeed depends on one or more other possible
C>                        second mnemonics, then those possible second
C.                        mnemonics are returned within this string, as a
C>                        series of IRET successive 8-byte substrings. 
C>                        An example of this scenario is included below
C>                        within the Remarks.
C> @param[out] LNMNG   -- integer: Length (in bytes) of string returned in
C>                        CMEANG
C> @param[out] IRET    -- integer: return code
C>                        -  0 = meaning found and stored in CMEANG string
C>                        - -1 = meaning not found
C>                        - >0 = meaning not found, <b>and</b> NEMOD and
C>                               IVALD were not specified on input,
C>                               <b>and</b> the meaning of NEMOI and IVALI
C>                               depends on the value of one of the
C>                               mnemonics stored in the first IRET 8-byte
C>                               substrings of CMEANG
C>
C> <p>As noted above, this subroutine first does an initial search of
C> the master Code/Flag tables based on the mnemonics and values provided.
C> The input parameters NEMOI and IVALI specify the mnemonic and
C> corresponding numerical code or flag table value for which the meaning
C> is sought, and the optional secondary parameters NEMOD and IVALD are
C> specified when needed to differentiate between multiple possible
C> results. An example of this particular scenario is included below
C> within the Remarks.  Otherwise, if the meaning of NEMOD and IVALD
C> does not depend on the value associated with any other mnemonic, then
C> NEMOD should be set to a field of all blank characters, and IVALD
C> should be set to a value of (-1).
C>
C> <p>Subroutine codflg() must be called with a CF value of 'Y' prior to
C> calling this subroutine, in order to ensure that master Code/Flag
C> tables have been read into internal memory.
C>
C> <p>This subroutine can be called at any time after a BUFR message
C> has been read into internal arrays by one of the BUFRLIB
C> [message-reading subroutines](@ref hierarchy), and it
C> can be called for any code or flag table mnemonic defined within that
C> particular message.  In most cases, this means that the mnemonic must
C> be contained within the subset definition (Section 3) of that message.
C> The only exceptions to this rule are for originating centers,
C> originating subcenters, data types and data subtypes, since those can
C> also be contained within the identification section (Section 1) of a
C> BUFR message.
C>
C> <p>It is the user's responsibility to provide sufficient allocated
C> space in CMEANG for the returned meaning string; otherwise, the
C> returned string will be truncated.
C>
C> @remarks
C> - An example of when secondary mnemonics NEMOD and IVALD would be
C> required is when a user is searching for the meaning of a numerical
C> code table value for an originating sub-center (i.e. mnemonic GSES).
C> The meaning of any originating sub-center value depends on the identity
C> of the originating center for which the sub-center in question is a
C> member, so in order for the subroutine to locate and return the proper
C> one, information about the originating center must also be provided. So
C> in this case the user would input GSES and the associated numerical
C> value as NEMOI and IVALI, respectively, but the user would also need to
C> specify an appropriate originating center mnemonic (e.g. GCLONG, OGCE
C> or ORIGC) and associated value from the same BUFR message as input
C> parameters NEMOD and IVALD, respectively, and then the subroutine will
C> be able to locate and return the appropriate meaning string. Otherwise,
C> if this information was not provided, the subroutine would return with
C> an IRET value of 3, and with each of the mnemonics GCLONG, OGCE and
C> ORIGC contained in successive 8-byte substrings of CMEANG (and with a
C> corresponding value of 24 returned for LNMNG), as a hint to the user
C> that more information needs to be input to the subroutine in order to
C> achieve the desired result.
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2018-01-11 | J. Ator | Original author |
C> | 2018-02-08 | J. Ator | Add special handling for data types and subtypes in Section 1 |
C>
    SUBROUTINE getcfmng ( LUNIT, NEMOI, IVALI, NEMOD, IVALD,
     .                CMEANG, LNMNG, IRET )
 
    USE moda_tababd
 
    COMMON /tablef/ cdmf
 
    character*(*)   nemoi, nemod, cmeang
 
    character*128   bort_str
    character*8 nemo
    character*1 cdmf, tab
 
    dimension   ifxyd(10)
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
    CALL status ( lunit, lun, il, im )
    IF ( il .EQ. 0 ) GOTO 900
    IF ( il .GT. 0 ) GOTO 901
    IF ( im .EQ. 0 ) GOTO 902
 
C*  Make sure the appropriate code/flag information has already been
C*  read into internal memory.
 
    IF ( cdmf .NE. 'Y' ) GOTO 903
 
    itmp = ireadmt( lun )
 
C*  Check the validity of the input mnemonic(s).  Include special
C*  handling for originating centers, originating subcenters, data
C*  types and data subtypes, since those can be reported in
C*  Section 1 of a BUFR message as well as in Section 3, so if a
C*  user requests those mnemonics we can't necessarily assume they
C*  came from within Section 3.
 
    lcmg = len( cmeang )
 
    IF ( nemoi(1:4) .EQ. 'GSES' ) THEN
        IF ( ( nemod(1:6) .EQ. 'GCLONG' ) .OR.
     .       ( nemod(1:4) .EQ. 'OGCE' ) .OR.
     .       ( nemod(1:5) .EQ. 'ORIGC' ) )  THEN
        ifxyi = ifxy( '001034' )
        ifxyd(1) = ifxy( '001035' )
        ELSE
        lnmng = min( 24, lcmg )
        IF ( lnmng .EQ. 24 ) THEN
            iret = 3
            cmeang(1:24) = 'GCLONG  OGCE    ORIGC   '
        ELSE
            iret = -1
        END IF
        RETURN
        END IF
    ELSE IF ( nemoi(1:6) .EQ. 'GCLONG' ) THEN
        ifxyi = ifxy( '001031' )
        ifxyd(1) = (-1)
    ELSE IF ( nemoi(1:4) .EQ. 'OGCE' ) THEN
        ifxyi = ifxy( '001033' )
        ifxyd(1) = (-1)
    ELSE IF ( nemoi(1:5) .EQ. 'ORIGC' ) THEN
        ifxyi = ifxy( '001035' )
        ifxyd(1) = (-1)
    ELSE IF ( ( nemoi(1:7) .EQ. 'TABLASS' ) .OR.
     +        ( nemoi(1:7) .EQ. 'TABLASL' ) ) THEN
        IF ( ( nemod(1:6) .EQ. 'TABLAT' ) ) THEN
        IF ( nemoi(1:7) .EQ. 'TABLASS' ) THEN
            ifxyi = ifxy( '055021' )
        ELSE
            ifxyi = ifxy( '055022' )
        ENDIF
        ifxyd(1) = ifxy( '055020' )
        ELSE
        lnmng = min( 8, lcmg )
        IF ( lnmng .EQ. 8 ) THEN
            iret = 1
            cmeang(1:8) = 'TABLAT  '
        ELSE
            iret = -1
        END IF
        RETURN
        END IF
    ELSE IF ( nemoi(1:6) .EQ. 'TABLAT' ) THEN
        ifxyi = ifxy( '055020' )
        ifxyd(1) = (-1)
    ELSE
        CALL parstr ( nemoi, nemo, 1, ntg, ' ', .true. )
        CALL nemtab ( lun, nemo, ifxyi, tab, n )
        IF ( ( n .EQ. 0 ) .OR. ( tab .NE. 'B' ) ) GOTO 904
        IF ( ( tabb( n, lun )(71:74) .NE. 'CODE' ) .AND.
     .       ( tabb( n, lun )(71:74) .NE. 'FLAG' ) ) GOTO 905
        IF ( nemod(1:1) .NE. ' ' ) THEN
        CALL parstr ( nemod, nemo, 1, ntg, ' ', .true. )
        CALL nemtab ( lun, nemo, ifxyd(1), tab, n )
        IF ( ( n .EQ. 0 ) .OR. ( tab .NE. 'B' ) ) GOTO 904
        IF ( ( tabb( n, lun )(71:74) .NE. 'CODE' ) .AND.
     .           ( tabb( n, lun )(71:74) .NE. 'FLAG' ) ) GOTO 905
        ELSE
            ifxyd(1) = (-1)
        END IF
    END IF
 
C*  Search the internal table for the requested meaning.
 
    CALL srchtbf ( ifxyi, ivali, ifxyd, 10, ivald,
     .             cmeang, lcmg, lnmng, iret )
    IF ( iret .LE. 0 ) RETURN
 
C*  The meaning of this value is dependent on the value of another
C*  mnemonic in the report.
 
    iret2 = iret
    lnmng = 0
    iret = 0
    DO ii = 1, iret2
        CALL numtbd ( lun, ifxyd(ii), nemo, tab, ierbd )
        IF ( ( ierbd .GT. 0 ) .AND. ( tab .EQ. 'B' ) .AND.
     .         ( lcmg .GE. ( lnmng + 8 ) ) ) THEN
        iret = iret + 1
        cmeang(lnmng+1:lnmng+8) = nemo
        lnmng = lnmng + 8
        END IF
    END DO
    IF ( iret .EQ. 0 ) iret = -1
 
    RETURN
900     CALL bort('BUFRLIB: GETCFMNG - INPUT BUFR FILE IS CLOSED, IT '//
     .   'MUST BE OPEN FOR INPUT')
901     CALL bort('BUFRLIB: GETCFMNG - INPUT BUFR FILE IS OPEN FOR '//
     .   'OUTPUT, IT MUST BE OPEN FOR INPUT')
902     CALL bort('BUFRLIB: GETCFMNG - A MESSAGE MUST BE OPEN IN '//
     .   'INPUT BUFR FILE, NONE ARE')
903     CALL bort('BUFRLIB: GETCFMNG - TO USE THIS SUBROUTINE, MUST '//
     .   'FIRST CALL SUBROUTINE CODFLG WITH INPUT ARGUMENT SET TO Y')
904 WRITE(bort_str,'("BUFRLIB: GETCFMNG - MNEMONIC ",A,'//
     .   '" NOT FOUND IN TABLE B")') nemo
    CALL bort(bort_str)
905     WRITE(bort_str,'("BUFRLIB: GETCFMNG - MNEMONIC ",A,'//
     .   '" IS NOT A CODE OR FLAG TABLE")') nemo
    CALL bort(bort_str)
    END