NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
binv.f90
1 !-----------------------------------------------------------------------
2 !-----------------------------------------------------------------------
3  PROGRAM binv
4 
5  parameter(maxsub=100)
6 
7  CHARACTER*255 file
8  CHARACTER*8 subset
9  CHARACTER*8 sub(maxsub)
10  dimension ninv(3,maxsub)
11  LOGICAL exist
12 
13  DATA bmiss /10e10/
14  DATA lunbf /20/
15 
16 !-----------------------------------------------------------------------
17 !-----------------------------------------------------------------------
18 
19 ! get filename
20 
21  narg=iargc()
22  IF(narg/=1) THEN
23  print *,'Usage: binv <bufrfile> will print bufrfile inventory by message type'
24  CALL EXIT(2)
25  ENDIF
26 
27  call getarg(1,file)
28  file = trim(file)//char(0)
29  inquire(file=file,exist=exist)
30  if (.not.exist) call bort(trim(file)//' does not exist')
31  open(lunbf,file=file,form='unformatted')
32 
33  ninv = 0
34  nsub = 0
35 
36 
37 ! COMPUTE AN MESSAGE INVENTORY BY SUBSETS
38 ! ---------------------------------------
39 
40  CALL openbf(lunbf,'IN',lunbf)
41  DO WHILE(ireadmg(lunbf,subset,idate).EQ.0)
42  isub = 0
43  DO i=1,nsub
44  IF(subset.EQ.sub(i)) isub = i
45  ENDDO
46  IF(isub.EQ.0) THEN
47  IF(nsub+1.GT.maxsub) CALL bort('NSUB TOO BIG')
48  sub(nsub+1) = subset
49  nsub = nsub+1
50  isub = nsub
51  ENDIF
52  ninv(1,isub) = ninv(1,isub)+1
53  ninv(2,isub) = ninv(2,isub)+nmsub(lunbf)
54  ninv(3,isub) = ninv(3,isub)+nmbyt(lunbf)
55  ENDDO
56 
57 ! PRINT THE INVEBTORY
58 ! -------------------
59 
60  print*
61  print'(a4,6x,3(a10,4x))','type','messages','subsets','bytes'
62  print*
63  DO j=1,nsub
64  xmsg = ninv(1,j)
65  xsub = ninv(2,j)
66  print'(A8,2X,3(I10,4X),f8.2)',sub(j),(ninv(i,j),i=1,3),xsub/xmsg
67  IF(j.GT.1) THEN
68  ninv(1,1) = ninv(1,1)+ninv(1,j)
69  ninv(2,1) = ninv(2,1)+ninv(2,j)
70  ninv(3,1) = ninv(3,1)+ninv(3,j)
71  ENDIF
72  ENDDO
73 
74  print'(A8,2X,3(I10,4X))','TOTAL ',(ninv(i,1),i=1,3)
75  print*
76 
77  stop
78  END
79  function nmbyt(lunit)
80  nmbyt = iupvs01(lunit,'LENM')
81  return
82  end
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 openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:138
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