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>
C> @author J. Ator @date 2018-01-11
 
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> @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> 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> 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> 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> 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> @author J. Ator @date 2018-01-11
        RECURSIVE SUBROUTINE getcfmng
     .      ( lunit, nemoi, ivali, nemod, ivald, cmeang, lnmng, iret )
 
        use bufrlib
 
        USE moda_tababd
        USE modv_im8b
 
        COMMON /tablef/ cdmf
 
        CHARACTER*(*)   nemoi, nemod, cmeang
 
        CHARACTER*128   bort_str
        CHARACTER*8     nemo, my_nemoi, my_nemod
        CHARACTER*1     cdmf, tab
 
        dimension       ifxyd(10)
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C*      Check for I8 integers.
 
        IF(im8b) THEN
          im8b=.false.
 
          CALL x84(lunit,my_lunit,1)
          CALL x84(ivali,my_ivali,1)
          CALL x84(ivald,my_ivald,1)
          CALL getcfmng(my_lunit,nemoi,my_ivali,nemod,my_ivald,cmeang,
     .                  lnmng,iret)
          CALL x48(lnmng,lnmng,1)
          CALL x48(iret,iret,1)
 
          im8b=.true.
          RETURN
        ENDIF
 
        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 )
 
        my_nemoi = '        '
        DO ii = 1, min( 8, len( nemoi ) )
            my_nemoi(ii:ii) = nemoi(ii:ii)
        END DO
        my_nemod = '        '
        DO ii = 1, min( 8, len( nemod ) )
            my_nemod(ii:ii) = nemod(ii:ii)
        END DO
        IF ( my_nemoi(1:4) .EQ. 'GSES' ) THEN
            IF ( ( my_nemod(1:6) .EQ. 'GCLONG' ) .OR.
     .           ( my_nemod(1:4) .EQ. 'OGCE' ) .OR.
     .           ( my_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 ( my_nemoi(1:6) .EQ. 'GCLONG' ) THEN
            ifxyi = ifxy( '001031' )
            ifxyd(1) = (-1)
        ELSE IF ( my_nemoi(1:4) .EQ. 'OGCE' ) THEN
            ifxyi = ifxy( '001033' )
            ifxyd(1) = (-1)
        ELSE IF ( my_nemoi(1:5) .EQ. 'ORIGC' ) THEN
            ifxyi = ifxy( '001035' )
            ifxyd(1) = (-1)
        ELSE IF ( ( my_nemoi(1:7) .EQ. 'TABLASS' ) .OR.
     +            ( my_nemoi(1:7) .EQ. 'TABLASL' ) ) THEN
            IF ( ( my_nemod(1:6) .EQ. 'TABLAT' ) ) THEN
                IF ( my_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 ( my_nemoi(1:6) .EQ. 'TABLAT' ) THEN
            ifxyi = ifxy( '055020' )
            ifxyd(1) = (-1)
        ELSE
            CALL parstr ( my_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 ( my_nemod(1:1) .NE. ' ' ) THEN
                CALL parstr ( my_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_c ( ifxyi, ivali, ifxyd(1), 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