binv.f

Go to the documentation of this file.

C> @file
C> @brief Print inventory of BUFR file by message type

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
      PROGRAM binv
 
      parameter(maxsub=100)
 
      CHARACTER*200 file   
      CHARACTER*8   subset
      CHARACTER*8   sub(maxsub)
      dimension     ninv(3,maxsub)
 
      DATA bmiss  /10e10/
      DATA lunbf  /20/
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
      ninv = 0
      nsub = 0

      read(5,'(a)') file
      open(lunbf,file=file,form='unformatted')
 
C  COMPUTE AN MESSAGE INVENTORY BY SUBSETS
C  ---------------------------------------
 
      CALL openbf(lunbf,'IN',lunbf)
      DO WHILE(ireadmg(lunbf,subset,idate).EQ.0)
      isub = 0
      DO i=1,nsub
      IF(subset.EQ.sub(i)) isub = i
      ENDDO
      IF(isub.EQ.0) THEN
         IF(nsub+1.GT.maxsub) CALL bort('NSUB TOO BIG')
         sub(nsub+1) = subset
         nsub = nsub+1
         isub = nsub
      ENDIF
      ninv(1,isub) = ninv(1,isub)+1
      ninv(2,isub) = ninv(2,isub)+nmsub(lunbf)
      ninv(3,isub) = ninv(3,isub)+nmbyt(lunbf)
 
c     IOFF = 1
c     CALL STATUS(LUNBF,LUN,IL,IM)
c     call ufbcnt(lunbf,irec,isub)
c     DO I=1,NMSUB(LUNBF)
c     NBYS = IUPB(MBAY(1,LUN),MBYT(LUN)+IOFF,16)
c     print*,SUBSET,' m#',irec,' subt#',i,nbys
c     IOFF = IOFF+NBYS
c     ENDDO
      ENDDO

C  PRINT THE INVEBTORY
C  -------------------
 
      print*
      print'(a4,6x,3(a10,4x))','type','messages','subsets','bytes'
      print*
      DO j=1,nsub
      xmsg = ninv(1,j)
      xsub = ninv(2,j)
      print'(A8,2X,3(I10,4X),f8.2)',sub(j),(ninv(i,j),i=1,3),xsub/xmsg
      IF(j.GT.1) THEN
         ninv(1,1) = ninv(1,1)+ninv(1,j)
         ninv(2,1) = ninv(2,1)+ninv(2,j)
         ninv(3,1) = ninv(3,1)+ninv(3,j)
      ENDIF
      ENDDO

      print'(A8,2X,3(I10,4X))','TOTAL   ',(ninv(i,1),i=1,3)
      print*
 
      stop
      END
      function nmbyt(lunit)
      nmbyt = iupvs01(lunit,'LENM')
      return
      end