NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
binv.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Print inventory of BUFR file by message type
3 
4 C-----------------------------------------------------------------------
5 C-----------------------------------------------------------------------
6  PROGRAM binv
7 
8  parameter(maxsub=100)
9 
10  CHARACTER*200 file
11  CHARACTER*8 subset
12  CHARACTER*8 sub(maxsub)
13  dimension ninv(3,maxsub)
14 
15  DATA bmiss /10e10/
16  DATA lunbf /20/
17 
18 C-----------------------------------------------------------------------
19 C-----------------------------------------------------------------------
20 
21  ninv = 0
22  nsub = 0
23 
24  read(5,'(a)') file
25  open(lunbf,file=file,form='unformatted')
26 
27 C COMPUTE AN MESSAGE INVENTORY BY SUBSETS
28 C ---------------------------------------
29 
30  CALL openbf(lunbf,'IN',lunbf)
31  DO WHILE(ireadmg(lunbf,subset,idate).EQ.0)
32  isub = 0
33  DO i=1,nsub
34  IF(subset.EQ.sub(i)) isub = i
35  ENDDO
36  IF(isub.EQ.0) THEN
37  IF(nsub+1.GT.maxsub) CALL bort('NSUB TOO BIG')
38  sub(nsub+1) = subset
39  nsub = nsub+1
40  isub = nsub
41  ENDIF
42  ninv(1,isub) = ninv(1,isub)+1
43  ninv(2,isub) = ninv(2,isub)+nmsub(lunbf)
44  ninv(3,isub) = ninv(3,isub)+nmbyt(lunbf)
45 
46 c IOFF = 1
47 c CALL STATUS(LUNBF,LUN,IL,IM)
48 c call ufbcnt(lunbf,irec,isub)
49 c DO I=1,NMSUB(LUNBF)
50 c NBYS = IUPB(MBAY(1,LUN),MBYT(LUN)+IOFF,16)
51 c print*,SUBSET,' m#',irec,' subt#',i,nbys
52 c IOFF = IOFF+NBYS
53 c ENDDO
54  ENDDO
55 
56 C PRINT THE INVEBTORY
57 C -------------------
58 
59  print*
60  print'(a4,6x,3(a10,4x))','type','messages','subsets','bytes'
61  print*
62  DO j=1,nsub
63  xmsg = ninv(1,j)
64  xsub = ninv(2,j)
65  print'(A8,2X,3(I10,4X),f8.2)',sub(j),(ninv(i,j),i=1,3),xsub/xmsg
66  IF(j.GT.1) THEN
67  ninv(1,1) = ninv(1,1)+ninv(1,j)
68  ninv(2,1) = ninv(2,1)+ninv(2,j)
69  ninv(3,1) = ninv(3,1)+ninv(3,j)
70  ENDIF
71  ENDDO
72 
73  print'(A8,2X,3(I10,4X))','TOTAL ',(ninv(i,1),i=1,3)
74  print*
75 
76  stop
77  END
78  function nmbyt(lunit)
79  nmbyt = iupvs01(lunit,'LENM')
80  return
81  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:43
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.F:157
function nmsub(LUNIT)
This function returns the total number of data subsets available within the BUFR message that was mos...
Definition: nmsub.f:31
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23
function iupvs01(LUNIT, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
Definition: iupvs01.f:71