PROGRAM READBUFR c======================================================================= c This program reads amsu data in bufr format and outputs brightness c temperatures and other information for use in tropical storm work. c======================================================================= c Progress: c 04/23/02 - Programming begun by Jack Dostalek CIRA/CSU/RAMM c 04/29/02 - Switched to helene, ulysses has trouble with readsb c 05/29/02 - Copy put on asp.ncep.noaa.gov c 06/19/02 - New output format made c 12/03/02 - Updated for NOAA-17 c 05/27/04 - Changed 1bamua.ibm to amuata.ibm for antenna temperatures c 12/12/05 - Updated for NOAA-18 c======================================================================= c Variables: character*2 cio !Input/output flag for openbf character*8 csubset character*20 cbufrin !Input bufr file name integer lubfr !Logical unit number for bufr file integer iret integer lundx integer idate real*8 r8arr(46,1) integer yr !Year integer mo !Month integer dy !Day integer hr !Hour integer mi !Minute integer se !Second real lat !Latitude real lon !Longitude integer sat !Satellite integer sensor !Sensor integer scanele !Scan element integer landsea !Land sea flag real satzen !Satellite zenith angle real solzen !Solar zenith angle integer elev !Surface elevation integer sathght !Satellite height real tb(15) !Brightness temperatures integer date integer time c======================================================================= c Data statements: data lubfr,luout15,luout16,luout17,luout18 /11,15,16,17,18/ data cbufrin,cio /'amuata.ibm','IN'/ c======================================================================= c Open output file c ------------- open(unit=luout15,file='noaa15.out',status='replace') open(unit=luout16,file='noaa16.out',status='replace') open(unit=luout17,file='noaa17.out',status='replace') open(unit=luout18,file='noaa18.out',status='replace') c Open bufr file c -------------- mxmn=46 mxlv=1 lundx=lubfr open(unit=lubfr,file=cbufrin,status='old',form='unformatted') call openbf(lubfr,cio,lundx) 10 call readmg(lubfr,csubset,idate,iret) if(iret.eq.0) then 30 call readsb(lubfr,iretsb) if(iretsb.eq.0) then call ufbseq(lubfr,r8arr,mxmn,mxlv,nlv,csubset) c r8arr is a real array, but not all values are best output as real c values. So here I will do some modifications before I write the data c out. This also will show what the values in r8arr are. yr=nint(r8arr(1,1)) mo=nint(r8arr(2,1)) dy=nint(r8arr(3,1)) hr=nint(r8arr(4,1)) mi=nint(r8arr(5,1)) se=nint(r8arr(6,1)) lat=r8arr(7,1) lon=r8arr(8,1) if(r8arr(9,1).eq.206) sat=15 if(r8arr(9,1).eq.207) sat=16 if(r8arr(9,1).eq.208) sat=17 if(r8arr(9,1).eq.209) sat=18 sensor=nint(r8arr(10,1)) if(sensor.eq.570) nchan=15 if(sensor.eq.547) nchan=5 scanele=nint(r8arr(11,1)) landsea=nint(r8arr(12,1)) satzen=r8arr(13,1) solzen=r8arr(14,1) elev=r8arr(15,1) sathght=r8arr(16,1) c The remaining values of r8arr are the channel numbers and c brightness temperatures, i.e., 1 tb1 2 tb2. I only need the c brightness temperatures, not the channel numbers themselves. do 40 n=1,nchan m=(n-1)*2 tb(n)=r8arr(18+m,1) if(tb(n).eq.1.0e11) tb(n)=-99.0 40 continue date=yr*10000+mo*100+dy time=hr*10000+mi*100+se if(sat.eq.15) then write(luout15,50) date,time,lat,lon,sat,sensor,scanele, & landsea,satzen,solzen,elev,sathght,(tb(n),n=1,15) elseif(sat.eq.16) then write(luout16,50) date,time,lat,lon,sat,sensor,scanele, & landsea,satzen,solzen,elev,sathght,(tb(n),n=1,15) elseif(sat.eq.17) then c c NOAA-17 does not have an AMSU-A anymore. c c write(luout17,50) date,time,lat,lon,sat,sensor,scanele, c & landsea,satzen,solzen,elev,sathght,(tb(n),n=1,15) elseif(sat.eq.18) then write(luout18,50) date,time,lat,lon,sat,sensor,scanele, & landsea,satzen,solzen,elev,sathght,(tb(n),n=1,15) endif 50 format(i8,1x,i6,1x,2(f8.3,1x),1x,i2,2x,i3,2x,i2,2x,i1,2x, & f8.3,1x,f8.3,1x,i5,2x,i6,2x,15(f6.2,2x)) goto 30 else goto 10 endif endif c Close files c ----------- call closbf(lubfr) close(unit=luout15) close(unit=luout16) close(unit=luout17) close(unit=luout18) stop end