NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
sinv.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Print inventory of BUFR satellite data file by platform and
3 C> instrument type
4 
5 C-----------------------------------------------------------------------
6 C-----------------------------------------------------------------------
7  PROGRAM sinv
8 
9  parameter(maxa=16000000)
10  parameter(maxs=1000)
11 
12  CHARACTER(255) file
13  CHARACTER(8) subset
14  CHARACTER ci*16,cj*80
15  dimension isat(0:maxs,0:maxs)
16  real(8) arr(2,maxa),said(maxa),siid(maxa)
17 
18  DATA bmiss /10e10/
19  DATA lunbf /20/
20 
21 C-----------------------------------------------------------------------
22 C-----------------------------------------------------------------------
23 
24  isat=0
25  said=0
26  ssid=0
27 
28  read(5,'(a)') file
29  !print*; print*,file; print*
30  open(lunbf,file=file,form='unformatted')
31 
32  CALL openbf(lunbf,'IN',lunbf)
33 
34  call ufbtab(lunbf,said,1,maxa,nret,'SAID')
35  !print*,nret
36  call ufbtab(lunbf,siid,1,maxa,nrex,'SIID')
37  !print*,nrex
38 
39  do n=1,nret
40  i = said(n)
41  j = siid(n)
42  if(i>maxs.or.i<0) i=0
43  if(j>maxs.or.j<0) j=0
44  isat(i,j) = isat(i,j)+1
45  enddo
46 
47  !print1,'satellite ','instrument ',' count'
48  !print'(40("-"))'
49  print*
50 1 format(a14,2x,a14,2x,a8)
51  do i=0,1000
52  do j=0,1000
53  if(isat(i,j).gt.0) then
54  call satcode(i,ci,j,cj)
55  if(ci==' ') write(ci,'(i4.4)')i
56  if(cj==' ') write(cj,'(i4.4)')j
57  print'(i3.3,2x,a10,2x,i10,2x,a80)',i,ci,isat(i,j),cj
58  endif
59  enddo
60  enddo; print*
61 
62  stop
63  end
64 c-----------------------------------------------------------------------
65 c looks up BUFR code table values for SAID (said) and SIID (instrument)
66 c-----------------------------------------------------------------------
67  subroutine satcode(icode,csad,jcode,csid)
68 
69  character(16) csad,saic(1000)
70  character(80) csid,siic(1000)
71  integer said,siid
72  logical first /.true./
73 
74  csad=' '; csid=' '
75 
76  if(first)then
77  open(8)
78  do i=1,1000
79  read(8,*,end=2) said,saic(said)
80  enddo
81 2 open(9)
82  do i=1,1000
83  read(9,4,end=3) siid,siic(siid)
84  enddo
85 3 first=.false.
86 4 format(i3,4x,a80)
87  endif
88 
89 c figure out what satellite this really is
90 
91  csad=saic(icode)
92  csid=siic(jcode)
93 
94  return
95  end
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:138
subroutine ufbtab(LUNIN, TAB, I1, I2, IRET, STR)
This subroutine reads through every data subset in a BUFR file and returns one or more specified data...
Definition: ufbtab.f:80