sinv.f90

Go to the documentation of this file.

 
 
program sinv
 
  parameter(maxa=16000000)
  parameter(maxs=1000)
 
  CHARACTER(255) file,tbldir
  CHARACTER(240) cmtdir
  CHARACTER(8)   subset
  CHARACTER      ci*16,cj*80
  dimension      isat(0:maxs,0:maxs)
  real(8)        said(maxa),siid(maxa)
  logical        exist
 
  DATA bmiss  /10e10/
  DATA lunbf  /20/
 
  !-----------------------------------------------------------------------
  !-----------------------------------------------------------------------
 
  isat=0
  jsat=0
  said=0
  ssid=0
 
  ! 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
     cmtdir = '/home/runner/work/NCEPLIBS-bufr/NCEPLIBS-bufr/bufr/build/ins' // &
'tall/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 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 = nint(said(n))
     j = nint(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(*,*)
  write(*,'(a14,12x,a14,4x,a10)') 'id   satellite', 'subsets  id   ', 'instrument'
  write(*,*)
  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,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