NCEPLIBS-bufr  11.6.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  call getarg(1, finput)
28  if (trim(adjustl(finput)) == '') finput = 'fort.20'
29 
31  inquire(file=trim(adjustl(finput)), exist=file_exists)
32  if (file_exists) then
33  open(lunit, file=trim(adjustl(finput)), form='unformatted')
34  call openbf(lunit,'IN',lunit)
35  else
36  call bort('File ' // trim(adjustl(finput)) // ' does not exist')
37  endif
38 
40  ninv = 0
41  nsub = 0
42  lsubunit = 50
43 
45  ireadmg_loop: do while(ireadmg(lunit, subset, idate) == 0)
46 
48  isub = 0
49  do ii = 1, nsub
50  if (subset == sub(ii)) then
51  isub = ii
52  continue
53  endif
54  enddo
55 
57  new_subset: if (isub == 0) then
59  if (nsub+1 > maxsub) call bort('nsub too big')
60  sub(nsub+1) = subset
61  isub = nsub+1
62  lsubunit(isub) = 50+isub
63 
65  open(lsubunit(isub), file=trim(adjustl(subset)), form='unformatted')
66  call openbf(lsubunit(isub), 'OUT', lunit)
67  if (nsub == 0) call maxout(20000)
68  nsub = nsub+1
69  endif new_subset
70 
72  ninv(1, isub) = ninv(1, isub) + 1
73  ninv(2, isub) = ninv(2, isub) + nmsub(lunit)
74  ninv(3, isub) = ninv(3, isub) + iupvs01(lunit, 'LENM')
75 
77  call copymg(lunit, lsubunit(isub))
78 
79  enddo ireadmg_loop
80 
82  do ii = 1,nsub
83  call closbf(lsubunit(ii))
84  enddo
85 
87  write(6,'(a)') repeat('#',48)
88  write(6,101) 'TYPE', 'MESSAGES', 'SUBSETS', 'BYTES'
89  write(6,'(a)') repeat('#',48)
90  do ii=1,nsub
91  write(6,102) sub(ii), (ninv(jj,ii),jj=1,3)
92  if (ii > 1) then
93  ninv(1,1) = ninv(1,1)+ninv(1,ii)
94  ninv(2,1) = ninv(2,1)+ninv(2,ii)
95  ninv(3,1) = ninv(3,1)+ninv(3,ii)
96  endif
97  enddo
98  write(6,'(a)') repeat('-',48)
99  write(6,102) 'TOTAL', (ninv(jj,1),jj=1,3)
100  write(6,'(a)') repeat('#',48)
101 
102 101 format(a8,2x,3(a10,4x))
103 102 format(a8,2x,3(i10,4x))
104 
105  stop
106 end program split_by_subset
107 
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