sinv.F90

Go to the documentation of this file.

 
 
program sinv
 
  parameter(maxa=16000000)
  parameter(maxs=1000)
 
  character(255) file
  character(240) cmtdir,tbldir
  character(8)   subset
  character      ci*16,cj*80
  dimension      isat(0:maxs,0:maxs)
  real(8)        said(2,maxa)
  logical        exist
 
  data lunbf  /20/
 
  !-----------------------------------------------------------------------
  !-----------------------------------------------------------------------
 
  isat=0
  jsat=0
  said=0
  ssid=0
 
  call setpart(.true.) ! put ufbtab in partial read mode
 
  ! get filename argument
 
  narg=command_argument_count()
  if(narg<1) then
     write(*,*)'Usage: sinv satbufrfile <tabledir> will print inventory of satbufrfile by platform and instrument'
     stop 2
  endif
  call get_command_argument(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
 
  ! Before calling mtinfo, make an initial call to openbf so that bfrini is called internally.
  ! Otherwise, if we wait until later to make the initial call to openbf, then the internal call
  ! to bfrini will end up overwriting the master table directory that we pass in during either
  ! of the following calls to mtinfo.
  call openbf(lunbf,'FIRST',lunbf)
  if(narg==2) then ! arg 2 would be a user defined table dir
     call get_command_argument(2,tbldir)
     call mtinfo(tbldir,3,4)
  else ! otherwise default table dir is used
     cmtdir = '/home/runner/work/NCEPLIBS-bufr/NCEPLIBS-bufr/bufr/build-doc' // &
's/install/tables'
     call mtinfo(cmtdir,3,4) 
  endif
 
  ! read through the file and collect counts of satid and sat inst combinations
 
  open(lunbf,file=file,form='unformatted')
  call openbf(lunbf,'IN',lunbf)
 
  nret=0
  do while(nret<=0) 
     call ufbtab(lunbf,said,2,maxa,nret,'SAID SIID')
     do n=1,abs(nret)
     i = nint(said(1,n))
     j = nint(said(2,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
  enddo
 
  ! need to open the bufrfile with the satellites of interest
 
  call readmg(lunbf,subset,idate,iret)
  call codflg('Y')
 
  ! print the summary of satid and sat inst combinations
 
  write(*,*)
  write(*,'(a14,12x,a14,4x,a10)') 'id   satellite', 'subsets  id   ', 'instrument'
  write(*,*)
  do i=0,1000
     do j=0,1000
        if(isat(i,j)>0) then
           jsat=jsat+isat(i,j)
           call satcode(lunbf,i,ci,j,cj)
           write(*,'(i3.3,2x,a,2x,i10,2x,i3.3,6x,a)')i,ci,isat(i,j),j,trim(adjustl(cj))
        endif
     enddo
  enddo
 
  write(*,'(/23x,i10/)') jsat
 
end program sinv
 
 
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)
  endif
  if(jcode>0) then
     str=repeat(' ',255)
     call getcfmng(lunit,'SIID',jcode,'  ',-1,str,len,iret); csid=str(1:80)
  endif
 
end subroutine satcode