sinv.f90

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
      PROGRAM sinv
 
      parameter(maxa=16000000)
      parameter(maxs=1000)
 
      CHARACTER(255) FILE,tbldir
      CHARACTER(100) cmtdir 
      CHARACTER(8)   SUBSET
      CHARACTER      ci*16,cj*80
      dimension      isat(0:maxs,0:maxs)  
      real(8)        arr(2,maxa),said(maxa),siid(maxa)
      logical        exist
 
      DATA bmiss  /10e10/
      DATA lunbf  /20/
 
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
 
      isat=0  
      jsat=0  
      said=0
      ssid=0
      !!close(6); open(6,recl=130)
 
!  get filename argument
 
      narg=iargc()
      IF(narg<1) THEN
        write(*,*)'Usage: sinv <satbufrfile> will print inventory of satellites by platform and instrument'
        CALL exit(2)
      ENDIF
      call getarg(1,file)
      file = trim(adjustl(file))
      inquire(file=file,exist=exist)
      if (.not.exist) call bort(trim(file)//' does not exist') 
 
  
!  define master table directory
 
      call openbf(lunbf,'FIRST',lunbf)  ! need to call openbf prior to calling mtinfo
      IF(narg==2) THEN ! arg 2 would be a user defined table dir
         call getarg(2,tbldir)
         call mtinfo(tbldir,3,4)
      else ! otherwise default table dir is used
         call mtinfo(           &
         "/home/jeffa/build/install/tables" &
         ,3,4)
      endif
 
! read through the file and collect counts of satid and sat inst combinations
 
      open(lunbf,file=file,form='unformatted')
      call ufbtab(lunbf,said,1,maxa,nret,'SAID')
      call ufbtab(lunbf,siid,1,maxa,nrex,'SIID')
 
! need to open the bufrfile with the satellites of interest
 
      open(lunbf,file=file,form='unformatted')
      CALL openbf(lunbf,'IN',lunbf)
      call readmg(lunbf,subset,idate,iret)
      call codflg('Y')
 
! make a table of sat ids and sat instruments 
 
      do n=1,max(nret,nrex)
      i = said(n)
      j = siid(n)  
      if(i>maxs.or.i<0) i=0                 
      if(j>maxs.or.j<0) j=0                 
      isat(i,j) = isat(i,j)+1
      enddo
 
! print the summary of satid and sat inst combinations
 
      write(*,*)
1     format(a14,2x,a14,2x,a8)
      do i=0,1000
      do j=0,1000
      if(isat(i,j).gt.0) then 
         jsat=jsat+isat(i,j)
         call satcode(lunbf,i,ci,j,cj)
         write(*,'(i3.3,2x,a16,2x,i10,2x,i3.3,a80)')i,ci,isat(i,j),j,trim(cj)
      endif
      enddo
      enddo
 
      write(*,'(/23x,i10/)') jsat
 
      end program 
!-----------------------------------------------------------------------
!  looks up BUFR code table values for SAID (said) and SIID (instrument)
!-----------------------------------------------------------------------
      subroutine satcode(lunit,icode,csad,jcode,csid)
 
      character(16)  :: csad
      character(80)  :: csid
      character(255) :: str
 
      csad(1:16)=' '; csid(1:80)=' '
 
!  call routines to look  up the said and siid 
 
      if(icode>0) then
         str=repeat(' ',255)
         call getcfmng(lunit,'SAID',icode,'  ',-1,str,len,iret); csad=str(1:16)
      elseif(jcode>0) then
         str=repeat(' ',255)
         call getcfmng(lunit,'SIID',jcode,'  ',-1,str,len,iret); csid=str(1:80)
      endif
 
      end subroutine