NCEPLIBS-bufr  12.0.0
split_by_subset.f90
Go to the documentation of this file.
1 
5 
14 
15 program split_by_subset
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(iargc()==1) then
35  call getarg(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 
bort
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
closbf
recursive subroutine closbf(LUNIT)
Close the connection between logical unit LUNIT and the NCEPLIBS-bufr software.
Definition: closbf.f:24
copymg
recursive subroutine copymg(LUNIN, LUNOT)
Copy a BUFR message from one file to another.
Definition: copymg.f:42
ireadmg
recursive function ireadmg(LUNIT, SUBSET, IDATE)
Calls NCEPLIBS-bufr subroutine readmg() and passes back its return code as the function value.
Definition: ireadmg.f:27
iupvs01
recursive function iupvs01(LUNIT, S01MNEM)
Read a specified value from within Section 0 or 1 of a BUFR message.
Definition: iupvs01.f:64
maxout
recursive 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:27
nmsub
recursive function nmsub(LUNIT)
This function returns the total number of data subsets available within the BUFR message that was mos...
Definition: nmsub.f:22
openbf
recursive subroutine openbf(LUNIT, IO, LUNDX)
Connects a new file to the NCEPLIBS-bufr software for input or output operations, or initializes the ...
Definition: openbf.f:124
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:15