109 SUBROUTINE getcfmng ( LUNIT, NEMOI, IVALI, NEMOD, IVALD,
110 . cmeang, lnmng, iret )
116 character*(*) nemoi, nemod, cmeang
118 character*128 bort_str
120 character*1 cdmf, tab
127 CALL
status( lunit, lun, il, im )
128 IF ( il .EQ. 0 ) goto 900
129 IF ( il .GT. 0 ) goto 901
130 IF ( im .EQ. 0 ) goto 902
135 IF ( cdmf .NE.
'Y' ) goto 903
148 IF ( nemoi(1:4) .EQ.
'GSES' )
THEN
149 IF ( ( nemod(1:6) .EQ.
'GCLONG' ) .OR.
150 . ( nemod(1:4) .EQ.
'OGCE' ) .OR.
151 . ( nemod(1:5) .EQ.
'ORIGC' ) )
THEN
152 ifxyi =
ifxy(
'001034' )
153 ifxyd(1) =
ifxy(
'001035' )
155 lnmng = min( 24, lcmg )
156 IF ( lnmng .EQ. 24 )
THEN
158 cmeang(1:24) =
'GCLONG OGCE ORIGC '
164 ELSE IF ( nemoi(1:6) .EQ.
'GCLONG' )
THEN
165 ifxyi =
ifxy(
'001031' )
167 ELSE IF ( nemoi(1:4) .EQ.
'OGCE' )
THEN
168 ifxyi =
ifxy(
'001033' )
170 ELSE IF ( nemoi(1:5) .EQ.
'ORIGC' )
THEN
171 ifxyi =
ifxy(
'001035' )
173 ELSE IF ( ( nemoi(1:7) .EQ.
'TABLASS' ) .OR.
174 + ( nemoi(1:7) .EQ.
'TABLASL' ) )
THEN
175 IF ( ( nemod(1:6) .EQ.
'TABLAT' ) )
THEN
176 IF ( nemoi(1:7) .EQ.
'TABLASS' )
THEN
177 ifxyi =
ifxy(
'055021' )
179 ifxyi =
ifxy(
'055022' )
181 ifxyd(1) =
ifxy(
'055020' )
183 lnmng = min( 8, lcmg )
184 IF ( lnmng .EQ. 8 )
THEN
186 cmeang(1:8) =
'TABLAT '
192 ELSE IF ( nemoi(1:6) .EQ.
'TABLAT' )
THEN
193 ifxyi =
ifxy(
'055020' )
196 CALL
parstr( nemoi, nemo, 1, ntg,
' ', .true. )
197 CALL
nemtab( lun, nemo, ifxyi, tab, n )
198 IF ( ( n .EQ. 0 ) .OR. ( tab .NE.
'B' ) ) goto 904
199 IF ( ( tabb( n, lun )(71:74) .NE.
'CODE' ) .AND.
200 . ( tabb( n, lun )(71:74) .NE.
'FLAG' ) ) goto 905
201 IF ( nemod(1:1) .NE.
' ' )
THEN
202 CALL
parstr( nemod, nemo, 1, ntg,
' ', .true. )
203 CALL
nemtab( lun, nemo, ifxyd(1), tab, n )
204 IF ( ( n .EQ. 0 ) .OR. ( tab .NE.
'B' ) ) goto 904
205 IF ( ( tabb( n, lun )(71:74) .NE.
'CODE' ) .AND.
206 . ( tabb( n, lun )(71:74) .NE.
'FLAG' ) ) goto 905
214 CALL
srchtbf( ifxyi, ivali, ifxyd, 10, ivald,
215 . cmeang, lcmg, lnmng, iret )
216 IF ( iret .LE. 0 )
RETURN
225 CALL
numtbd( lun, ifxyd(ii), nemo, tab, ierbd )
226 IF ( ( ierbd .GT. 0 ) .AND. ( tab .EQ.
'B' ) .AND.
227 . ( lcmg .GE. ( lnmng + 8 ) ) )
THEN
229 cmeang(lnmng+1:lnmng+8) = nemo
233 IF ( iret .EQ. 0 ) iret = -1
236 900 CALL
bort(
'BUFRLIB: GETCFMNG - INPUT BUFR FILE IS CLOSED, IT '//
237 .
'MUST BE OPEN FOR INPUT')
238 901 CALL
bort(
'BUFRLIB: GETCFMNG - INPUT BUFR FILE IS OPEN FOR '//
239 .
'OUTPUT, IT MUST BE OPEN FOR INPUT')
240 902 CALL
bort(
'BUFRLIB: GETCFMNG - A MESSAGE MUST BE OPEN IN '//
241 .
'INPUT BUFR FILE, NONE ARE')
242 903 CALL
bort(
'BUFRLIB: GETCFMNG - TO USE THIS SUBROUTINE, MUST '//
243 .
'FIRST CALL SUBROUTINE CODFLG WITH INPUT ARGUMENT SET TO Y')
244 904
WRITE(bort_str,
'("BUFRLIB: GETCFMNG - MNEMONIC ",A,'//
245 .
'" NOT FOUND IN TABLE B")') nemo
247 905
WRITE(bort_str,
'("BUFRLIB: GETCFMNG - MNEMONIC ",A,'//
248 .
'" IS NOT A CODE OR FLAG TABLE")') nemo
subroutine parstr(STR, TAGS, MTAG, NTAG, SEP, LIMIT80)
THIS SUBROUTINE PARSES A STRING CONTAINING ONE OR MORE SUBSTRINGS INTO AN ARRAY OF SUBSTRINGS...
This module contains array and variable declarations used to store DX BUFR tables internally for mult...
subroutine numtbd(LUN, IDN, NEMO, TAB, IRET)
This subroutine searches for a descriptor within Table B and Table D of the internal DX BUFR tables...
function ifxy(ADSC)
This function converts an FXY value from its 6 character representation to its bit-wise (integer) rep...
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
subroutine nemtab(LUN, NEMO, IDN, TAB, IRET)
This subroutine returns information about a descriptor from the internal DX BUFR tables, based on the mnemonic associated with that descriptor.
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
INTEGER function ireadmt(LUN)
This function checks the most recent BUFR message that was read via a call to one of the message-read...
subroutine getcfmng(LUNIT, NEMOI, IVALI, NEMOD, IVALD, CMEANG, LNMNG, IRET)
This subroutine searches for a specified Table B mnemonic and associated value (code figure or bit nu...
void srchtbf(f77int *, f77int *, f77int *, f77int *, f77int *, char *, f77int *, f77int *, f77int *)
This subroutine searches for a specified FXY number and associated value (code figure or bit number) ...