NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
mtfnam.f
Go to the documentation of this file.
1 C> @file
2 C> @author ATOR @date 2017-10-16
3 
4 C> BASED ON THE INPUT ARGUMENTS, THIS SUBROUTINE DETERMINES
5 C> THE NAMES OF THE CORRESPONDING STANDARD AND LOCAL MASTER TABLE
6 C> FILES. IT THEN CONFIRMS THE EXISTENCE OF THESE FILES ON THE
7 C> FILESYSTEM, USING ADDITIONAL INFORMATION OBTAINED FROM THE MOST
8 C> RECENT CALL TO SUBROUTINE MTINFO, OR ELSE AS DEFINED WITHIN
9 C> SUBROUTINE BFRINI IF SUBROUTINE MTINFO WAS NEVER CALLED.
10 C>
11 C> PROGRAM HISTORY LOG:
12 C> 2017-10-16 J. ATOR -- ORIGINAL AUTHOR
13 C>
14 C> USAGE: CALL MTFNAM ( IMT, IMTV, IOGCE, IMTVL, TBLTYP,
15 C> STDFIL, LOCFIL )
16 C> INPUT ARGUMENT LIST:
17 C> IMT - INTEGER: MASTER TABLE NUMBER
18 C> IMTV - INTEGER: MASTER TABLE VERSION NUMBER
19 C> IOGCE - INTEGER: ORIGINATING CENTER
20 C> IMTVL - INTEGER: LOCAL TABLE VERSION NUMBER
21 C> TBLTYP - CHARACTER*(*): TABLE TYPE:
22 C> 'TableB' = Table B
23 C> 'TableD' = Table D
24 C> 'CodeFlag' = Code and Flag Tables
25 C>
26 C> OUTPUT ARGUMENT LIST:
27 C> STDFIL - CHARACTER*(*): STANDARD MASTER TABLE PATH/FILENAME
28 C> LOCFIL - CHARACTER*(*): LOCAL MASTER TABLE PATH/FILENAME
29 C>
30 C> REMARKS:
31 C> THIS ROUTINE CALLS: BORT2 ERRWRT ISIZE STRSUC
32 C> THIS ROUTINE IS CALLED BY: IREADMT
33 C> Normally not called by any application
34 C> programs.
35 C>
36  SUBROUTINE mtfnam ( IMT, IMTV, IOGCE, IMTVL, TBLTYP,
37  . stdfil, locfil )
38 
39  COMMON /quiet/ iprt
40  COMMON /mstinf/ lun1, lun2, lmtd, mtdir
41 
42  character*(*) stdfil, locfil, tbltyp
43 
44  character*16 tbltyp2
45  character*20 fmtf
46  character*100 mtdir
47  character*128 bort_str
48  logical found
49 
50 C-----------------------------------------------------------------------
51 C-----------------------------------------------------------------------
52 
53  CALL strsuc( tbltyp, tbltyp2, ltbt )
54 
55 C* Determine the standard master table path/filename.
56 
57  IF ( ( imt .EQ. 0 ) .AND. ( imtv .LE. 13 ) ) THEN
58 
59 C* For master table 0, version 13 is a superset of all earlier
60 C* versions.
61 
62  stdfil = mtdir(1:lmtd) // '/bufrtab.' // tbltyp2(1:ltbt) //
63  . '_STD_0_13'
64  ELSE
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
69  ENDIF
70  IF ( iprt .GE. 2 ) THEN
71  CALL errwrt('Standard ' // tbltyp2(1:ltbt) // ':')
72  CALL errwrt(stdfil)
73  ENDIF
74  INQUIRE ( file = stdfil, exist = found )
75  IF ( .NOT. found ) goto 900
76 
77 C* Now determine the local master table path/filename.
78 
79 C* Use the local table corresponding to the originating center
80 C* and local table version number, if such a table exists.
81 C* Otherwise use the local table from NCEP.
82 
83  WRITE ( fmtf, '(A,I1,A,I1,A,I1,A)' )
84  . '(4A,I', isize(imt), ',A,I', isize(iogce),
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) // ':')
90  CALL errwrt(locfil)
91  ENDIF
92  INQUIRE ( file = locfil, exist = found )
93  IF ( .NOT. found ) THEN
94 
95 C* Use the local table from NCEP.
96 
97  locfil = mtdir(1:lmtd) // '/bufrtab.' // tbltyp2(1:ltbt) //
98  . '_LOC_0_7_1'
99  IF ( iprt .GE. 2 ) THEN
100  CALL errwrt('Local ' // tbltyp2(1:ltbt) //
101  . 'not found, so using:')
102  CALL errwrt(locfil)
103  ENDIF
104  INQUIRE ( file = locfil, exist = found )
105  IF ( .NOT. found ) goto 901
106  ENDIF
107 
108  RETURN
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)
113  END
subroutine strsuc(STR1, STR2, LENS)
This subroutine removes leading and trailing blanks from a character string.
Definition: strsuc.f:23
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
Definition: bort2.f:22
subroutine mtfnam(IMT, IMTV, IOGCE, IMTVL, TBLTYP, STDFIL, LOCFIL)
BASED ON THE INPUT ARGUMENTS, THIS SUBROUTINE DETERMINES THE NAMES OF THE CORRESPONDING STANDARD AND ...
Definition: mtfnam.f:36
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:41
INTEGER function isize(NUM)
THIS FUNCTION COMPUTES AND RETURNS THE NUMBER OF CHARACTERS NEEDED TO ENCODE THE INPUT INTEGER NUM AS...
Definition: isize.f:27