binv.f90

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
      PROGRAM binv
 
      parameter(maxsub=100)
 
      CHARACTER*255 FILE   
      CHARACTER*8   SUBSET
      CHARACTER*8   SUB(MAXSUB)
      dimension     ninv(3,maxsub)
      LOGICAL       EXIST
 
      DATA bmiss  /10e10/
      DATA lunbf  /20/
 
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
 
!  get filename
 
      narg=iargc()
      IF(narg/=1) THEN
        print *,'Usage: binv <bufrfile> will print bufrfile inventory by message type'
        CALL exit(2)
      ENDIF
 
      call getarg(1,file)
      file = trim(file)//char(0)
      inquire(file=file,exist=exist)
      if (.not.exist) call bort(trim(file)//' does not exist') 
      open(lunbf,file=file,form='unformatted')
 
      ninv = 0
      nsub = 0
 
 
!  COMPUTE AN MESSAGE INVENTORY BY SUBSETS
!  ---------------------------------------
 
      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)
      ENDDO
 
!  PRINT THE INVEBTORY
!  -------------------
 
      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