NCEPLIBS-bufr  12.1.0
split_by_subset.F90
Go to the documentation of this file.
1 
5 
14 
16 
17  implicit none
18 
19  integer, parameter :: maxsub = 100
20  integer, parameter :: lunit = 20
21  real(8), parameter :: bmiss = 10e10
22 
23  character(len=255) :: finput
24  character(len=8) :: subset, sub(maxsub)
25  integer(4), dimension(3, maxsub) :: ninv
26  integer(4) :: idate
27  integer(4) :: ireadmg, nmsub, iupvs01
28  integer :: nsub, isub, ii, jj
29  logical :: file_exists
30  integer, dimension(maxsub) :: lsubunit
31 
33 
34  if(command_argument_count()==1) then
35  call get_command_argument(1, finput)
36  inquire(file=trim(adjustl(finput)), exist=file_exists)
37  if (file_exists) then
38  open(lunit, file=trim(adjustl(finput)), form='unformatted')
39  call openbf(lunit,'IN',lunit)
40  else
41  write(6,'(a)') 'File ' // trim(adjustl(finput)) // ' does not exist'
42  call exit(1)
43  endif
44  else
45  write(6,'(a)') 'Usage: split_by_subset <bufrfile> will split a BUFR file into subsets'
46  call exit(2)
47  endif
48 
50  ninv = 0
51  nsub = 0
52  lsubunit = 50
53 
55  ireadmg_loop: do while(ireadmg(lunit, subset, idate) == 0)
56 
58  isub = 0
59  do ii = 1, nsub
60  if (subset == sub(ii)) then
61  isub = ii
62  continue
63  endif
64  enddo
65 
67  new_subset: if (isub == 0) then
69  if (nsub+1 > maxsub) call bort('nsub too big')
70  sub(nsub+1) = subset
71  isub = nsub+1
72  lsubunit(isub) = 50+isub
73 
75  open(lsubunit(isub), file=trim(adjustl(subset)), form='unformatted')
76  call openbf(lsubunit(isub), 'OUT', lunit)
77  if (nsub == 0) call maxout(20000)
78  nsub = nsub+1
79  endif new_subset
80 
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')
85 
87  call copymg(lunit, lsubunit(isub))
88 
89  enddo ireadmg_loop
90 
92  do ii = 1,nsub
93  call closbf(lsubunit(50+ii))
94  enddo
95 
97  write(6,'(a)') repeat('#',48)
98  write(6,101) 'TYPE', 'MESSAGES', 'SUBSETS', 'BYTES'
99  write(6,'(a)') repeat('#',48)
100  do ii=1,nsub
101  write(6,102) sub(ii), (ninv(jj,ii),jj=1,3)
102  if (ii > 1) then
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)
106  endif
107  enddo
108  write(6,'(a)') repeat('-',48)
109  write(6,102) 'TOTAL', (ninv(jj,1),jj=1,3)
110  write(6,'(a)') repeat('#',48)
111 
112 101 format(a8,2x,3(a10,4x))
113 102 format(a8,2x,3(i10,4x))
114 
115  stop
116 end program split_by_subset
117 
subroutine bort(str)
Log an error message, then abort the application program.
Definition: borts.F90:15
recursive subroutine copymg(lunin, lunot)
Copy a BUFR message from one file to another.
Definition: copydata.F90:108
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.
Definition: s013vals.F90:443
program split_by_subset
Read BUFR file messages, collating them into output files by message type/subtype (eg NC001002,...