NCEPLIBS-bufr 11.7.1
split_by_subset.f90
Go to the documentation of this file.
1
5
8
9program split_by_subset
10
11 implicit none
12
13 integer, parameter :: maxsub = 100
14 integer, parameter :: lunit = 20
15 real(8), parameter :: bmiss = 10e10
16
17 character(len=255) :: finput
18 character(len=8) :: subset, sub(maxsub)
19 integer(4), dimension(3, maxsub) :: ninv
20 integer(4) :: idate
21 integer(4) :: ireadmg, nmsub, iupvs01
22 integer :: nsub, isub, ii, jj
23 logical :: file_exists
24 integer, dimension(maxsub) :: lsubunit
25
27
28 if(iargc()==1) then
29 call getarg(1, finput)
30 inquire(file=trim(adjustl(finput)), exist=file_exists)
31 if (file_exists) then
32 open(lunit, file=trim(adjustl(finput)), form='unformatted')
33 call openbf(lunit,'IN',lunit)
34 else
35 call bort('File ' // trim(adjustl(finput)) // ' does not exist')
36 endif
37 else
38 call bort('Usage: "split_by_subset bufrfile" will split a BUFR file into subsets')
39 endif
40
42 ninv = 0
43 nsub = 0
44 lsubunit = 50
45
47 ireadmg_loop: do while(ireadmg(lunit, subset, idate) == 0)
48
50 isub = 0
51 do ii = 1, nsub
52 if (subset == sub(ii)) then
53 isub = ii
54 continue
55 endif
56 enddo
57
59 new_subset: if (isub == 0) then
61 if (nsub+1 > maxsub) call bort('nsub too big')
62 sub(nsub+1) = subset
63 isub = nsub+1
64 lsubunit(isub) = 50+isub
65
67 open(lsubunit(isub), file=trim(adjustl(subset)), form='unformatted')
68 call openbf(lsubunit(isub), 'OUT', lunit)
69 if (nsub == 0) call maxout(20000)
70 nsub = nsub+1
71 endif new_subset
72
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')
77
79 call copymg(lunit, lsubunit(isub))
80
81 enddo ireadmg_loop
82
84 do ii = 1,nsub
85 call closbf(lsubunit(50+ii))
86 enddo
87
89 write(6,'(a)') repeat('#',48)
90 write(6,101) 'TYPE', 'MESSAGES', 'SUBSETS', 'BYTES'
91 write(6,'(a)') repeat('#',48)
92 do ii=1,nsub
93 write(6,102) sub(ii), (ninv(jj,ii),jj=1,3)
94 if (ii > 1) then
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)
98 endif
99 enddo
100 write(6,'(a)') repeat('-',48)
101 write(6,102) 'TOTAL', (ninv(jj,1),jj=1,3)
102 write(6,'(a)') repeat('#',48)
103
104101 format(a8,2x,3(a10,4x))
105102 format(a8,2x,3(i10,4x))
106
107 stop
108end program split_by_subset
109
bort
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23
closbf
subroutine closbf(LUNIT)
This subroutine closes the connection between logical unit LUNIT and the BUFRLIB software.
Definition: closbf.f:35
copymg
subroutine copymg(LUNIN, LUNOT)
This subroutine copies a BUFR message from one Fortran logical unit to another.
Definition: copymg.f:56
ireadmg
function ireadmg(LUNIT, SUBSET, IDATE)
This function calls BUFRLIB subroutine readmg() and passes back its return code as the function value...
Definition: ireadmg.f:40
iupvs01
function iupvs01(LUNIT, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message.
Definition: iupvs01.f:74
maxout
subroutine maxout(MAXO)
This subroutine allows the user to define the maximum length of a BUFR message that can be written to...
Definition: maxout.f:39
nmsub
function nmsub(LUNIT)
This function returns the total number of data subsets available within the BUFR message that was mos...
Definition: nmsub.f:30
openbf
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:139
split_by_subset
program split_by_subset
Read BUFR file messages, collating them into output files by message type/subtype (eg NC001002,...
Definition: split_by_subset.f90:9