36 SUBROUTINE mtfnam ( IMT, IMTV, IOGCE, IMTVL, TBLTYP,
40 COMMON /mstinf/ lun1, lun2, lmtd, mtdir
42 character*(*) stdfil, locfil, tbltyp
47 character*128 bort_str
53 CALL
strsuc( tbltyp, tbltyp2, ltbt )
57 IF ( ( imt .EQ. 0 ) .AND. ( imtv .LE. 13 ) )
THEN
62 stdfil = mtdir(1:lmtd) //
'/bufrtab.' // tbltyp2(1:ltbt) //
65 WRITE ( fmtf,
'(A,I1,A,I1,A)' )
66 .
'(4A,I',
isize(imt),
',A,I',
isize(imtv),
')'
67 WRITE ( stdfil, fmtf ) mtdir(1:lmtd),
'/bufrtab.',
68 . tbltyp2(1:ltbt),
'_STD_', imt,
'_', imtv
70 IF ( iprt .GE. 2 )
THEN
71 CALL
errwrt(
'Standard ' // tbltyp2(1:ltbt) //
':')
74 INQUIRE ( file = stdfil, exist = found )
75 IF ( .NOT. found ) goto 900
83 WRITE ( fmtf,
'(A,I1,A,I1,A,I1,A)' )
85 .
',A,I',
isize(imtvl),
')'
86 WRITE ( locfil, fmtf ) mtdir(1:lmtd),
'/bufrtab.',
87 . tbltyp2(1:ltbt),
'_LOC_', imt,
'_', iogce,
'_', imtvl
88 IF ( iprt .GE. 2 )
THEN
89 CALL
errwrt(
'Local ' // tbltyp2(1:ltbt) //
':')
92 INQUIRE ( file = locfil, exist = found )
93 IF ( .NOT. found )
THEN
97 locfil = mtdir(1:lmtd) //
'/bufrtab.' // tbltyp2(1:ltbt) //
99 IF ( iprt .GE. 2 )
THEN
100 CALL
errwrt(
'Local ' // tbltyp2(1:ltbt) //
101 .
'not found, so using:')
104 INQUIRE ( file = locfil, exist = found )
105 IF ( .NOT. found ) goto 901
109 900 bort_str =
'BUFRLIB: MTFNAM - COULD NOT FIND STANDARD FILE:'
110 CALL
bort2(bort_str,stdfil)
111 901 bort_str =
'BUFRLIB: MTFNAM - COULD NOT FIND LOCAL FILE:'
112 CALL
bort2(bort_str,locfil)
subroutine strsuc(STR1, STR2, LENS)
This subroutine removes leading and trailing blanks from a character string.
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
subroutine mtfnam(IMT, IMTV, IOGCE, IMTVL, TBLTYP, STDFIL, LOCFIL)
BASED ON THE INPUT ARGUMENTS, THIS SUBROUTINE DETERMINES THE NAMES OF THE CORRESPONDING STANDARD AND ...
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
INTEGER function isize(NUM)
THIS FUNCTION COMPUTES AND RETURNS THE NUMBER OF CHARACTERS NEEDED TO ENCODE THE INPUT INTEGER NUM AS...