19 integer,
parameter :: maxsub = 100
20 integer,
parameter :: lunit = 20
21 real(8),
parameter :: bmiss = 10e10
23 character(len=255) :: finput
24 character(len=8) :: subset, sub(maxsub)
25 integer(4),
dimension(3, maxsub) :: ninv
28 integer :: nsub, isub, ii, jj
29 logical :: file_exists
30 integer,
dimension(maxsub) :: lsubunit
34 if(command_argument_count()==1)
then
35 call get_command_argument(1, finput)
36 inquire(file=trim(adjustl(finput)), exist=file_exists)
38 open(lunit, file=trim(adjustl(finput)), form=
'unformatted')
39 call openbf(lunit,
'IN',lunit)
41 write(6,
'(a)')
'File ' // trim(adjustl(finput)) //
' does not exist'
45 write(6,
'(a)')
'Usage: split_by_subset <bufrfile> will split a BUFR file into subsets'
55 ireadmg_loop:
do while(
ireadmg(lunit, subset, idate) == 0)
60 if (subset == sub(ii))
then
67 new_subset:
if (isub == 0)
then
69 if (nsub+1 > maxsub)
call bort(
'nsub too big')
72 lsubunit(isub) = 50+isub
75 open(lsubunit(isub), file=trim(adjustl(subset)), form=
'unformatted')
76 call openbf(lsubunit(isub),
'OUT', lunit)
77 if (nsub == 0)
call maxout(20000)
82 ninv(1, isub) = ninv(1, isub) + 1
83 ninv(2, isub) = ninv(2, isub) +
nmsub(lunit)
84 ninv(3, isub) = ninv(3, isub) +
iupvs01(lunit,
'LENM')
87 call copymg(lunit, lsubunit(isub))
93 call closbf(lsubunit(50+ii))
97 write(6,
'(a)') repeat(
'#',48)
98 write(6,101)
'TYPE',
'MESSAGES',
'SUBSETS',
'BYTES'
99 write(6,
'(a)') repeat(
'#',48)
101 write(6,102) sub(ii), (ninv(jj,ii),jj=1,3)
103 ninv(1,1) = ninv(1,1)+ninv(1,ii)
104 ninv(2,1) = ninv(2,1)+ninv(2,ii)
105 ninv(3,1) = ninv(3,1)+ninv(3,ii)
108 write(6,
'(a)') repeat(
'-',48)
109 write(6,102)
'TOTAL', (ninv(jj,1),jj=1,3)
110 write(6,
'(a)') repeat(
'#',48)
112 101
format(a8,2x,3(a10,4x))
113 102
format(a8,2x,3(i10,4x))
subroutine bort(str)
Log an error message, then abort the application program.
recursive subroutine copymg(lunin, lunot)
Copy a BUFR message from one file to another.
recursive subroutine closbf(lunit)
Close the connection between logical unit lunit and the NCEPLIBS-bufr software.
recursive subroutine openbf(lunit, io, lundx)
Connect a new file to the NCEPLIBS-bufr software for input or output operations, or initialize the li...
recursive subroutine maxout(maxo)
Specify the maximum length of a BUFR message that can be written to any output file by the NCEPLIBS-b...
recursive integer function nmsub(lunit)
Get the total number of data subsets available within the BUFR message that was most recently opened ...
recursive integer function ireadmg(lunit, subset, idate)
Call subroutine readmg() and pass back its return code as the function value.
recursive integer function iupvs01(lunit, s01mnem)
Read a specified value from within Section 0 or 1 of a BUFR message.
program split_by_subset
Read BUFR file messages, collating them into output files by message type/subtype (eg NC001002,...