NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
split_by_subset.f90
Go to the documentation of this file.
1 
5 
8 
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 !> functions from bufr library
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 
104 101 format(a8,2x,3(a10,4x))
105 102 format(a8,2x,3(i10,4x))
106 
107  stop
108 end program split_by_subset
109 
function ireadmg(LUNIT, SUBSET, IDATE)
This function calls BUFRLIB subroutine readmg() and passes back its return code as the function value...
Definition: ireadmg.f:39
subroutine copymg(LUNIN, LUNOT)
This subroutine copies a BUFR message from one Fortran logical unit to another.
Definition: copymg.f:55
subroutine closbf(LUNIT)
This subroutine closes the connection between logical unit LUNIT and the BUFRLIB software.
Definition: closbf.f:34
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:138
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...
Definition: nmsub.f:29
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
function iupvs01(LUNIT, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
Definition: iupvs01.f:73
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:38