13 integer,
parameter :: maxsub = 100
14 integer,
parameter :: lunit = 20
15 real(8),
parameter :: bmiss = 10e10
17 character(len=255) :: finput
18 character(len=8) :: subset, sub(maxsub)
19 integer(4),
dimension(3, maxsub) :: ninv
22 integer :: nsub, isub, ii, jj
23 logical :: file_exists
24 integer,
dimension(maxsub) :: lsubunit
29 call getarg(1, finput)
30 inquire(file=trim(adjustl(finput)), exist=file_exists)
32 open(lunit, file=trim(adjustl(finput)), form=
'unformatted')
33 call
openbf(lunit,
'IN',lunit)
35 call
bort(
'File ' // trim(adjustl(finput)) //
' does not exist')
38 call
bort(
'Usage: "split_by_subset bufrfile" will split a BUFR file into subsets')
47 ireadmg_loop:
do while(
ireadmg(lunit, subset, idate) == 0)
52 if (subset == sub(ii))
then
59 new_subset:
if (isub == 0)
then
61 if (nsub+1 > maxsub) call
bort(
'nsub too big')
64 lsubunit(isub) = 50+isub
67 open(lsubunit(isub), file=trim(adjustl(subset)), form=
'unformatted')
68 call
openbf(lsubunit(isub),
'OUT', lunit)
69 if (nsub == 0) call
maxout(20000)
74 ninv(1, isub) = ninv(1, isub) + 1
75 ninv(2, isub) = ninv(2, isub) +
nmsub(lunit)
76 ninv(3, isub) = ninv(3, isub) +
iupvs01(lunit,
'LENM')
79 call
copymg(lunit, lsubunit(isub))
85 call
closbf(lsubunit(50+ii))
89 write(6,
'(a)') repeat(
'#',48)
90 write(6,101)
'TYPE',
'MESSAGES',
'SUBSETS',
'BYTES'
91 write(6,
'(a)') repeat(
'#',48)
93 write(6,102) sub(ii), (ninv(jj,ii),jj=1,3)
95 ninv(1,1) = ninv(1,1)+ninv(1,ii)
96 ninv(2,1) = ninv(2,1)+ninv(2,ii)
97 ninv(3,1) = ninv(3,1)+ninv(3,ii)
100 write(6,
'(a)') repeat(
'-',48)
101 write(6,102)
'TOTAL', (ninv(jj,1),jj=1,3)
102 write(6,
'(a)') repeat(
'#',48)
104 101
format(a8,2x,3(a10,4x))
105 102
format(a8,2x,3(i10,4x))
function ireadmg(LUNIT, SUBSET, IDATE)
This function calls BUFRLIB subroutine readmg() and passes back its return code as the function value...
subroutine copymg(LUNIN, LUNOT)
This subroutine copies a BUFR message from one Fortran logical unit to another.
subroutine closbf(LUNIT)
This subroutine closes the connection between logical unit LUNIT and the BUFRLIB software.
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
program split_by_subset
Read BUFR file messages, collating them into output files by message type/subtype (eg NC001002...
function nmsub(LUNIT)
This function returns the total number of data subsets available within the BUFR message that was mos...
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
function iupvs01(LUNIT, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
subroutine maxout(MAXO)
This subroutine allows the user to define the maximum length of a BUFR message that can be written to...