108 SUBROUTINE getcfmng ( LUNIT, NEMOI, IVALI, NEMOD, IVALD,
109 . cmeang, lnmng, iret )
115 character*(*) nemoi, nemod, cmeang
117 character*128 bort_str
119 character*1 cdmf, tab
126 CALL
status( lunit, lun, il, im )
127 IF ( il .EQ. 0 ) goto 900
128 IF ( il .GT. 0 ) goto 901
129 IF ( im .EQ. 0 ) goto 902
134 IF ( cdmf .NE.
'Y' ) goto 903
147 IF ( nemoi(1:4) .EQ.
'GSES' )
THEN
148 IF ( ( nemod(1:6) .EQ.
'GCLONG' ) .OR.
149 . ( nemod(1:4) .EQ.
'OGCE' ) .OR.
150 . ( nemod(1:5) .EQ.
'ORIGC' ) )
THEN
151 ifxyi =
ifxy(
'001034' )
152 ifxyd(1) =
ifxy(
'001035' )
154 lnmng = min( 24, lcmg )
155 IF ( lnmng .EQ. 24 )
THEN
157 cmeang(1:24) =
'GCLONG OGCE ORIGC '
163 ELSE IF ( nemoi(1:6) .EQ.
'GCLONG' )
THEN
164 ifxyi =
ifxy(
'001031' )
166 ELSE IF ( nemoi(1:4) .EQ.
'OGCE' )
THEN
167 ifxyi =
ifxy(
'001033' )
169 ELSE IF ( nemoi(1:5) .EQ.
'ORIGC' )
THEN
170 ifxyi =
ifxy(
'001035' )
172 ELSE IF ( ( nemoi(1:7) .EQ.
'TABLASS' ) .OR.
173 + ( nemoi(1:7) .EQ.
'TABLASL' ) )
THEN
174 IF ( ( nemod(1:6) .EQ.
'TABLAT' ) )
THEN
175 IF ( nemoi(1:7) .EQ.
'TABLASS' )
THEN
176 ifxyi =
ifxy(
'055021' )
178 ifxyi =
ifxy(
'055022' )
180 ifxyd(1) =
ifxy(
'055020' )
182 lnmng = min( 8, lcmg )
183 IF ( lnmng .EQ. 8 )
THEN
185 cmeang(1:8) =
'TABLAT '
191 ELSE IF ( nemoi(1:6) .EQ.
'TABLAT' )
THEN
192 ifxyi =
ifxy(
'055020' )
195 CALL
parstr( nemoi, nemo, 1, ntg,
' ', .true. )
196 CALL
nemtab( lun, nemo, ifxyi, tab, n )
197 IF ( ( n .EQ. 0 ) .OR. ( tab .NE.
'B' ) ) goto 904
198 IF ( ( tabb( n, lun )(71:74) .NE.
'CODE' ) .AND.
199 . ( tabb( n, lun )(71:74) .NE.
'FLAG' ) ) goto 905
200 IF ( nemod(1:1) .NE.
' ' )
THEN
201 CALL
parstr( nemod, nemo, 1, ntg,
' ', .true. )
202 CALL
nemtab( lun, nemo, ifxyd(1), tab, n )
203 IF ( ( n .EQ. 0 ) .OR. ( tab .NE.
'B' ) ) goto 904
204 IF ( ( tabb( n, lun )(71:74) .NE.
'CODE' ) .AND.
205 . ( tabb( n, lun )(71:74) .NE.
'FLAG' ) ) goto 905
213 CALL
srchtbf( ifxyi, ivali, ifxyd, 10, ivald,
214 . cmeang, lcmg, lnmng, iret )
215 IF ( iret .LE. 0 )
RETURN
224 CALL
numtbd( lun, ifxyd(ii), nemo, tab, ierbd )
225 IF ( ( ierbd .GT. 0 ) .AND. ( tab .EQ.
'B' ) .AND.
226 . ( lcmg .GE. ( lnmng + 8 ) ) )
THEN
228 cmeang(lnmng+1:lnmng+8) = nemo
232 IF ( iret .EQ. 0 ) iret = -1
235 900 CALL
bort(
'BUFRLIB: GETCFMNG - INPUT BUFR FILE IS CLOSED, IT '//
236 .
'MUST BE OPEN FOR INPUT')
237 901 CALL
bort(
'BUFRLIB: GETCFMNG - INPUT BUFR FILE IS OPEN FOR '//
238 .
'OUTPUT, IT MUST BE OPEN FOR INPUT')
239 902 CALL
bort(
'BUFRLIB: GETCFMNG - A MESSAGE MUST BE OPEN IN '//
240 .
'INPUT BUFR FILE, NONE ARE')
241 903 CALL
bort(
'BUFRLIB: GETCFMNG - TO USE THIS SUBROUTINE, MUST '//
242 .
'FIRST CALL SUBROUTINE CODFLG WITH INPUT ARGUMENT SET TO Y')
243 904
WRITE(bort_str,
'("BUFRLIB: GETCFMNG - MNEMONIC ",A,'//
244 .
'" NOT FOUND IN TABLE B")') nemo
246 905
WRITE(bort_str,
'("BUFRLIB: GETCFMNG - MNEMONIC ",A,'//
247 .
'" 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 AN INTEGER IDN, CONTAINING THE BIT-WISE REPRESENTATION OF A DESCRIPTOR (...
function ifxy(ADSC)
THIS FUNCTION RETURNS THE INTEGER CORRESPONDING TO THE BIT-WISE REPRESENTATION OF AN INPUT CHARACTER ...
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
INTEGER function ireadmt(LUN)
THIS FUNCTION CHECKS THE MOST RECENT BUFR MESSAGE THAT WAS READ AS INPUT VIA SUBROUTINE READMG...
subroutine nemtab(LUN, NEMO, IDN, TAB, IRET)
THIS SUBROUTINE SEARCHES FOR MNEMONIC NEMO WITHIN THE INTERNAL TABLE B AND D ARRAYS HOLDING THE DICTI...
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
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) ...