NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
dumpbf.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1996-12-11
3 
4 C> THIS SUBROUTINE RETURNS THE SECTION 1 DATE IN THE FIRST
5 C> TWO NON-DICTIONARY BUFR MESSAGES IN LOGICAL UNIT LUNIT WHICH
6 C> CONTAIN ZERO SUBSETS. NORMALLY, THESE "DUMMY" MESSAGES APPEAR
7 C> ONLY IN DATA DUMP FILES AND ARE IMMEDIATELY AFTER THE DICTIONARY
8 C> MESSAGES. THEY CONTAIN A DUMP "CENTER TIME" AND A DUMP FILE
9 C> "PROCESSING TIME", RESPECTIVELY. LUNIT SHOULD NOT BE PREVIOUSLY
10 C> OPENED TO THE BUFR INTERFACE.
11 C>
12 C> PROGRAM HISTORY LOG:
13 C> 1996-12-11 J. WOOLLEN -- ORIGINAL AUTHOR
14 C> 1996-12-17 J. WOOLLEN -- CORRECTED ERROR IN DUMP DATE READER
15 C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
16 C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
17 C> ROUTINE "BORT"; MODIFIED TO MAKE Y2K
18 C> COMPLIANT
19 C> 2003-05-19 M. SHIREY -- REPLACED CALLS TO FORTRAN INSRINSIC
20 C> FUNCTION ICHAR WITH THE NCEP W3LIB C-
21 C> FUNCTION MOVA2I BECAUSE ICHAR DOES NOT WORK
22 C> PROPERLY ON SOME MACHINES (E.G., IBM FROST/
23 C> SNOW) (NOTE: ON 2003-??-??, MOVA2I WAS
24 C> ADDED TO THE BUFRLIB AS A FORTRAN FUNCTION)
25 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
26 C> INTERDEPENDENCIES
27 C> 2003-11-04 D. KEYSER -- MODIFIED DATE CALCULATIONS TO NO LONGER
28 C> USE FLOATING POINT ARITHMETIC SINCE THIS
29 C> CAN LEAD TO ROUND OFF ERROR AND AN IMPROPER
30 C> RESULTING DATE ON SOME MACHINES (E.G., NCEP
31 C> IBM FROST/SNOW), INCREASES PORTABILITY;
32 C> UNIFIED/PORTABLE FOR WRF; ADDED
33 C> DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
34 C> MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
35 C> TERMINATES ABNORMALLY OR UNUSUAL THINGS
36 C> HAPPEN
37 C> 2004-08-18 J. ATOR -- MODIFIED 'BUFR' STRING TEST FOR PORTABILITY
38 C> TO EBCDIC MACHINES
39 C> 2004-12-20 D. KEYSER -- CALLS WRDLEN TO INITIALIZE LOCAL MACHINE
40 C> INFORMATION (IN CASE IT HAS NOT YET BEEN
41 C> CALLED), THIS ROUTINE DOES NOT REQUIRE IT
42 C> BUT 2004-08-18 CHANGE CALLS OTHER ROUTINES
43 C> THAT DO REQUIRE IT
44 C> 2005-11-29 J. ATOR -- USE IUPBS01, IGETDATE, GETLENS AND RDMSGW
45 C> 2009-03-23 J. ATOR -- USE IDXMSG, IUPBS3 AND ERRWRT
46 C> 2012-09-15 J. WOOLLEN -- MODIFIED FOR C/I/O/BUFR INTERFACE;
47 C> USE NEW OPENBF TYPE 'INX' TO OPEN AND CLOSE
48 C> THE C FILE WITHOUT CLOSING THE FORTRAN FILE
49 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
50 C>
51 C> USAGE: CALL DUMPBF (LUNIT, JDATE, JDUMP)
52 C> INPUT ARGUMENT LIST:
53 C> LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
54 C>
55 C> OUTPUT ARGUMENT LIST:
56 C> JDATE - INTEGER: 5-WORD ARRAY CONTAINING THE YEAR
57 C> (YYYY OR YY, DEPENDING ON DATELEN() VALUE),
58 C> MONTH, DAY, HOUR AND MINUTE FROM SECTION 1 OF THE
59 C> FIRST NON-DICTIONARY BUFR MESSAGE WITH ZERO SUBSETS
60 C> (NORMALLY THE DATA DUMP CENTER TIME IN A DATA DUMP
61 C> FILE); OR 5*-1 IF THIS COULD NOT BE LOCATED
62 C> JDUMP - INTEGER: 5-WORD ARRAY CONTAINING THE YEAR
63 C> (YYYY OR YY, DEPENDING ON DATELEN() VALUE),
64 C> MONTH, DAY, HOUR AND MINUTE FROM SECTION 1 OF THE
65 C> SECOND NON-DICTIONARY BUFR MESSAGE WITH ZERO SUBSETS
66 C> (NORMALLY THE FILE PROCESSING TIME IN A DATA DUMP
67 C> FILE); OR 5*-1 IF THIS COULD NOT BE LOCATED
68 C>
69 C> INPUT FILES:
70 C> UNIT "LUNIT" - BUFR FILE
71 C>
72 C> REMARKS:
73 C> THIS ROUTINE CALLS: BORT ERRWRT IDXMSG IGETDATE
74 C> IUPBS01 IUPBS3 RDMSGW STATUS
75 C> WRDLEN
76 C> THIS ROUTINE IS CALLED BY: None
77 C> Normally called only by application
78 C> programs.
79 C>
80  SUBROUTINE dumpbf(LUNIT,JDATE,JDUMP)
81 
82  USE moda_mgwa
83 
84  COMMON /quiet / iprt
85 
86  dimension jdate(5),jdump(5)
87 
88  CHARACTER*128 errstr
89 
90 C-----------------------------------------------------------------------
91 C-----------------------------------------------------------------------
92 
93 C CALL SUBROUTINE WRDLEN TO INITIALIZE SOME IMPORTANT INFORMATION
94 C ABOUT THE LOCAL MACHINE (IN CASE IT HAS NOT YET BEEN CALLED)
95 C ---------------------------------------------------------------
96 
97  CALL wrdlen
98 
99  DO i=1,5
100  jdate(i) = -1
101  jdump(i) = -1
102  ENDDO
103 
104 C SEE IF THE FILE IS ALREADY OPEN TO BUFR INTERFACE (A NO-NO)
105 C -----------------------------------------------------------
106 
107  CALL status(lunit,lun,jl,jm)
108  IF(jl.NE.0) goto 900
109  call openbf(lunit,'INX',lunit)
110 
111 C READ PAST ANY DICTIONARY MESSAGES
112 C ---------------------------------
113 
114 1 CALL rdmsgw(lunit,mgwa,ier)
115  IF(ier.LT.0) goto 200
116  IF(idxmsg(mgwa).EQ.1) goto 1
117 
118 C DUMP CENTER YY,MM,DD,HH,MM IS IN THE FIRST EMPTY MESSAGE
119 C --------------------------------------------------------
120 C i.e. the first message containing zero subsets
121 
122  IF(iupbs3(mgwa,'NSUB').NE.0) goto 200
123 
124  igd = igetdate(mgwa,jdate(1),jdate(2),jdate(3),jdate(4))
125  jdate(5) = iupbs01(mgwa,'MINU')
126 
127 C DUMP CLOCK YY,MM,DD,HH,MM IS IN THE SECOND EMPTY MESSAGE
128 C --------------------------------------------------------
129 C i.e. the second message containing zero subsets
130 
131  CALL rdmsgw(lunit,mgwa,ier)
132  IF(ier.LT.0) goto 200
133 
134  IF(iupbs3(mgwa,'NSUB').NE.0) goto 200
135 
136  igd = igetdate(mgwa,jdump(1),jdump(2),jdump(3),jdump(4))
137  jdump(5) = iupbs01(mgwa,'MINU')
138 
139  call closbf(lunit)
140  goto 100
141 
142 200 IF(iprt.GE.1 .AND. (jdate(1).EQ.-1.OR.jdump(1).EQ.-1)) THEN
143  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
144  IF(jdate(1).EQ.-1) THEN
145  errstr = 'BUFRLIB: DUMPBF - FIRST EMPTY BUFR MESSAGE '//
146  . 'SECTION 1 DATE COULD NOT BE LOCATED - RETURN WITH '//
147  . 'JDATE = 4*-1'
148  CALL errwrt(errstr)
149  ENDIF
150  IF(jdump(1).EQ.-1) THEN
151  errstr = 'BUFRLIB: DUMPBF - SECOND EMPTY BUFR MESSAGE '//
152  . 'SECTION 1 DATE COULD NOT BE LOCATED - RETURN WITH '//
153  . 'JDUMP = 4*-1'
154  CALL errwrt(errstr)
155  ENDIF
156  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
157  CALL errwrt(' ')
158  ENDIF
159 
160 C EXITS
161 C -----
162 
163 100 RETURN
164 900 CALL bort
165  . ('BUFRLIB: DUMPBF - INPUT BUFR FILE IS OPEN, IT MUST BE CLOSED')
166  END
function iupbs3(MBAY, S3MNEM)
This function returns a specified value from within Section 3 of a BUFR message.
Definition: iupbs3.f:34
function igetdate(MBAY, IYR, IMO, IDY, IHR)
This function returns the date-time from within Section 1 of a BUFR message.
Definition: igetdate.f:34
subroutine rdmsgw(LUNIT, MESG, IRET)
THIS SUBROUTINE READS THE NEXT BUFR MESSAGE FROM LOGICAL UNIT LUNIT AS AN ARRAY OF INTEGER WORDS...
Definition: rdmsgw.f:37
subroutine closbf(LUNIT)
This subroutine closes the connection between logical unit LUNIT and the BUFRLIB software.
Definition: closbf.f:34
function idxmsg(MESG)
This function determines whether a given BUFR message contains DX BUFR tables information that was ge...
Definition: idxmsg.f:23
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
Definition: status.f:55
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:138
subroutine wrdlen
This subroutine figures out some important information about the local machine on which the BUFRLIB s...
Definition: wrdlen.F:35
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:41
subroutine dumpbf(LUNIT, JDATE, JDUMP)
THIS SUBROUTINE RETURNS THE SECTION 1 DATE IN THE FIRST TWO NON-DICTIONARY BUFR MESSAGES IN LOGICAL U...
Definition: dumpbf.f:80
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
function iupbs01(MBAY, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
Definition: iupbs01.f:73