NOAA Polar Orbiter Data User's GuideAppendix M |
Introduction Page, NOAA POD Guide TOC, Acronyms,The original HIRS calibration procedure (described in Section 4.5 of the NOAA Polar Orbiter Data User's Guide) uses the fixed calibration coefficients calculated from the last calibration scans on the first half scans of a superswath and those calculated from the following calibration scans on the second half of the superswath. This method causes a jump in the values of the brightness temperatures at the center of a superswath and it does not take into consideration the change of the environmental temperatures through a superswath.
The new calibration procedure bases the calibration on the information from calibration scans at both ends of a superswath but also takes into account the change of the environmental temperatures. The input data to the new calibration software is a superswath of HIRS Level 1b data and the slopes and intercepts for 43 scan lines are the output. There are a total of 43 scan lines in a superswath; with scan lines 1-3 and 41-43 containing calibration scans which start with a space-view scan, followed by a cold-blackbody-view scan and a warm-blackbody-view scan; and scan lines 4-40 being earth-view scans.
The coefficients between instrument temperatures and the calibration coefficients were calculated from a test data set and is saved in the file: predcoef.txt.
The calibration coefficients at the two ends are calculated. Only the last 48 spots of both space-view scan and warm-blackbody-view scan are used in the calculation. If the count value at a spot is off (>3 counts) from the average of the line, it is filtered out. At the same time, the calibration coefficients are predicted from the instrument temperatures with the coefficients from 'predcoef.txt'. The difference between the calculated and predicted coefficients are saved as the bias.
The calibration coefficients of the earth-view scans are also predicted from the instrument temperatures. The predicted slopes and intercepts are adjusted to remove the biases at the two ends so that the predicted and calculated values agree at these two points. The bias corrections for the intervening earth data are interpolated from the two end values.
This package contains the programs and necessary data to process HIRS Level1b data and obtain the brightness temperatures (BT) of the HIRS channels. A new calibration procedure is implemented in this package. This package is suitable for big endian platforms. If the user wants to use it on a little endian platform, then it must be modified accordingly. Many compilers have options to do this, but it should be noted that the program uses bit patterns for flags and these must be changed as well. The following lists the names and a brief description of the software, data and common areas used in this package. The sample input datasets and outputs are separate files which can be downloaded by clicking on the individual links listed below. (Please be patient - some of these files are fairly large and take some time to download.)
It should be noted that this package works for NOAA-12 only. If a user wants to use it on other satellites's HIRS observations (TIROS-N, NOAA-6 through NOAA-14 series), then some coefficients (such as predcoef.txt, cofw1, bandc, waven) need to be changed accordingly.
Note that the Planck formula constants used in the function brightn and subroutine newhirscali are the old values used at the time the data were processed. The newer values recommended by the 1998 Committee on Data for Science and Technology (CODATA) are: C1 = 1.1910427x 10-5 mW/(m2-sr-cm-4) and C2 = 1.4387752 cm-K. The effect of these new constants on the temperature values is very small. For some uses, it may be appropriate to change to the new values.
The following are two common blocks that are used throughout this calibration procedure:
c c *** common superdata *** c c used for HIRS superswath data processing package ********* C! suphirs(2128,43) int*2 a superswath of Level1b data C! 43 scanlines, 1-3,41-43 C! calibration scans, 4-40 C! earth view scans. C! hirsdat(35,56,40) real*4 a superswath of result BT C! i=1,35;j=1,56,k=1,40 C! i: the order of the parameters 1-35; C! j: the spot sequence 1-56; C! k: the scan num of the superswath 1-40; C! ************************************************** C! parameters: C! i=1: flag =1 earth view & good quality C! =2 space view & good quality C! =3 cold blackbody & good quality C! =4 warm blackbody & good quality C! =-1 bad quality C! =-2 rain detected C! =-3 cloud detected C! C! i=2: latitude C! i=3: longitude C! i=4: year C! i=5: julian day C! i=6: UTC time C! i=7: height C! i=8: local zenith angle C! i=9: HIRS channel 1 BT C! i=10: HIRS channel 2 BT C! ...... C! ...... C! i=26: HIRS channel 18 BT C! i=27: HIRS channel 19 BT C! i=28: HIRS channel 20 BT C! i=33: flag for calibration: 1 good; C! -1 head suspicious (too many spots thrown away); C! -2 tail suspicious; C! i=other: reserved for future use C! *************************************************** c integer*2 suphirs, irfail real*4 hirsdat common/superdata/suphirs(2128,43),hirsdat(35,56,40),irfail c c *** common toohi *** c c version 1.0 6/11/80 g.domm (sasc) c limits on HIRS, MSU, SSU data allowed to be written to output c datasets of preprocessor. c 6/20/83 limits stored are now radiances instead of temps (f.c.) c used by hircal,msucal,ssucal,readlm,rfldp,$tprps c real toohih(20),tooloh(20) real toolom(4),toohim(4) real toohis(3),toolos(3) c common /toohi/toohih,tooloh,toohim,toolom,toohis,toolos c
The following listings are FORTRAN programs or functions that calculate the HIRS calibration for NOAA-12 data.
program hirsbt C!************************************************************** C! main program to get HIRS channels 1-19 brightness temperature and C! channel 20 albedo from HIRS Level1b data. Use a new calibration package C! newhirscali.f 12/04/01 C! C! This version is for big endian platforms!!!! C! If used on little endian machine, need some switch on C! variables associated with equivalence. C!************************************************************** c*************************************************************** c key local parameters- c variable type function c -------- ---- -------- C! isexp int expected next scan num C! isact int actual scan num C! idiff int isact-isexp C! isup int seq num of the contingent superswath C! iirec int the seq of recorded superswath C! hunit int input lun C! hirsdat real*4 output data for a superswath C! nameh char* input data file C! ounit int output lun C! nameout char* output data file C! nhirs int*2 one scan of Level 1b data C satid int satellite id C! sflags int view flags of scan C! suphirs int*2 a superswath of Level 1b data C! c subprograms called - readlm, rdhdr, gethirs c c restrictions- none c c*************************************************************** c* include 'superdata.cmn' include 'toohi.cmn' integer*2 ifill,satid character*120 nameh character*80 nameout c integer*4 sflags,hunit,ounit,iirec,idiff integer*4 isup integer*2 nfl(2),nhirs(2128),isexp, isact equivalence (sflags,nfl(1)) c cllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll c data ifill/'Z7FFF'/ clllllllllllllllllllllllllllllllllllllllllllllllllllllllllll c open HIRS & MSU Level 1b data , open geography, albedo, sft files clllllllllllllllllllllllllllllllllllllllllllllllllllllllllll hunit = 20 ounit = 30 c================================================================== c read allowed limits on radiances in input data c call readlm clllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll iirec=0 irfail=0 print *, 'Please input the HIRS Level 1b filename:' read(*,*)nameh C! nameh='hirs0955.dat' nameout='hirsbt'//nameh(14:18)//nameh(21:24)//nameh(27:30)//'.dat' print *, nameout open(ounit,file=nameout,form='formatted', . status='unknown') open(hunit, . file=nameh, . form='unformatted', status='old' . ,access='direct',recl=4256) clllllllllllllllllllllllllllllllllllllllllllllllllllllllllll c read HIRS header record clllllllllllllllllllllllllllllllllllllllllllllllllllllllllll c call rdhdr(hunit,5,4256,numsch,numdgh,iredtm,'hirs',satid) nrec=1 !try to read here ! read(hunit,rec=1,iostat=jstat) nhirs C! print *,'hdr hirs' C! print *,numsch,numdgh,satid clllllllllllllllllllllllllllllllllllllllllllllllllllllllllll c construct a superswath, and goto 5100 try to find c the start scanline of a superswath clllllllllllllllllllllllllllllllllllllllllllllllllllllllllll C! check whether start from space, if so C! start the superswath, if else, go to find the start 5100 isup=0 nrec=nrec+1 read (hunit, rec=nrec, end=5120, iostat=ioerr) nhirs C! nflags C! if for little endian platform, switch 1&2 for all following nfl nfl(1)=nhirs(5) nfl(2)=nhirs(6) if(btest(sflags,25)) go to 5100 if (.not.btest(sflags,24)) go to 5100 C! print * , 'First scanline=', nhirs(1) do in=1,2128 suphirs(in,1)= nhirs(in) enddo C! suppose to read the cold and warm blackbody records do ir=1,2 nrec=nrec+1 read (hunit, rec=nrec,end=5120, iostat=ioerr) nhirs do in=1,2128 suphirs(in,1+ir)= nhirs(in) enddo enddo C! nflags nfl(1)=nhirs(5) nfl(2)=nhirs(6) if(.not. btest(sflags,25) .or. .not. btest(sflags,24)) then print *, 'Not the warm blackbody scan!' go to 5100 endif isexp=nhirs(1)+1 c... do loop 350 processes superswath 1 to 30 (usually #superswaths <26 in a file) do 350 idatps=1,30 mumss=idatps ipasct=idatps iswfal=6 C! if not the contingent superswath then assign the last superswath's C! last 3 line as the first 3 line of new swath if( isup .ne. 0) then do in=1,2128 suphirs(in,1)= suphirs(in,41) suphirs(in,2)= suphirs(in,42) suphirs(in,3)= suphirs(in,43) enddo endif c... do loop 330 processes 40 lines of the superswath c idiff=0 do 330 iss=4,40 !from first earth view to last earth view if (idiff .gt.0) go to 320 5500 nrec=nrec+1 read (hunit, rec=nrec, end=5120, iostat=ioerr) nhirs print *,'The scanline #',nhirs(1) isact=nhirs(1) C! check whether a gap in the data if (isact .gt. isexp) then print *, 'There is a gap between scan lines!' ,isact,isexp idiff=isact - isexp if(idiff .gt. 10) go to 5100 C! still put the scan in the position do in=1,2128 suphirs(in,iss+idiff)= nhirs(in) enddo go to 320 else if (isact .lt. isexp) then go to 5500 endif do in=1,2128 suphirs(in,iss)= nhirs(in) enddo goto 328 320 do in=1,2128 suphirs(in,iss)= -9999 enddo idiff=idiff-1 328 isexp = nhirs(1)+1 330 continue C! continue to read the next calibration part nrec=nrec+1 read (hunit, rec=nrec, end=5120, iostat=ioerr) nhirs isact=nhirs(1) C! print * , 'scanline=', nhirs(1) C! check whether a gap in the data if (isact .ne. isexp) then print *, 'There is a gap between scan lines!' print *, 'Pay attention to the flag of the scan!!' endif C! nflags nfl(1)=nhirs(5) nfl(2)=nhirs(6) if(btest(sflags,25)) then print *, 'Not the space line? Go back for a new superswath!' go to 5100 endif if (.not.btest(sflags,24)) then print *, 'Not the space line? Go back for a new superswath!' go to 5100 endif C! if really a space view do in=1,2128 suphirs(in,41)= nhirs(in) enddo C! suppose to read the warm blackbody records do ir=1,2 nrec=nrec+1 read (hunit, rec=nrec,end=5120, iostat=ioerr) nhirs do in=1,2128 suphirs(in,41+ir)= nhirs(in) enddo enddo C! nflags nfl(1)=nhirs(5) nfl(2)=nhirs(6) if(.not. btest(sflags,25) .or. .not. btest(sflags,24)) then print *, 'Not warm blackbody! Not a valid superswath!' print *, 'Start to find a new super swath!!' go to 5100 endif C! set a new isexp ........ isexp=nhirs(1)+1 isup=isup+1 C! print * , '#',isup, ' superswath' C!************************************************************* C! finished construction of a superswath C!************************************************************* c c... process HIRS data c call gethirs C! if fail in processing the superswath, go to next if(irfail .eq. 1) go to 350 C! output the result ************************* iirec=iirec+1 print *,iirec write(ounit,*)iirec write(ounit,900)(((hirsdat(i,j,k),i=1,35),j=1,56),k=1,40) 900 format(7F12.3) 350 continue cl 360 continue close(hunit) close(ounit) 5120 stop end subroutine newhirscali(pslope,pintcpt) C************************************************************************* C! This subroutine inputs a superswath of the HIRS Level 1b data, outputs C! the calibration coefficients for channels 1-19 C************************************************************************* C! Description of variables: ! ! suphirs : input superswath, 43 lines (1-3, 41-43 calibration scans, 4-40 earthview) ! pslope : output slope ! pintcpt : output intercept ! ! band,bandc : HIRS/2 band correction coefficients ! c1,c2 : parameters for calculating radiance ! cofw,cofw1 : coefficients for warm blackbody brightness temperature ! coslope : coefficients for predicting slope ! cointcpt: coefficients for predicting intercepts ! iord : order of each channel's location in the data set ! irfail : flag: 0: good calibration; 1: bad calibration ! mfq : quqlity info for each spot ! nflags : flags for each scan line ! nslope : calculated slope at two ends ! nintcpt : calculated intercept at two ends ! onehir : one scan line of HIRS data ! prtw : warm blackbody temperature ! prtrad : radiance from the warm blackbody ! scount : space view counts ! wcount : warm blackbody view counts ! warmt : warm blackbody temperature counts ! sinst : space scan instrument temperatures (counts) ! winst : warm blackbody scan instrument temperatures (counts) ! tstar : band corrected warm blackbody temperature ! C************************************************************************* include 'superdata.cmn' C! integer*2 suphirs(2128,43) real*4 pslope(43,19),pintcpt(43,19) real*4 prtw(4),band(38),bandc(2,19) real*4 difslope(2,19),difintcpt(2,19),cofw(5,4),cofw1(20) real*4 waven(20),ainst(8),coslope(9,19),cointcpt(9,19) integer*2 sinst(8),winst(8),iord(20) integer*2 scount(56,20),wcount(56,20),warmt(20) integer*2 onehir(2128) integer*4 nflags,ind(2),irfail logical*1 mfq(56) real*4 tstar(19),smean(19),wmean(19),prtrad(19) real*4 nslope(2,19),nintcpt(2,19) C! Some flags equivalence (mfq(1),onehir(1891)),(nflags,onehir(5)) C! IWT PRT Count to temperature coefficients, this is for NOAA12 data cofw1/ 1 301.38300,6.52454E-03,8.63834E-08,4.81705E-11,1.17918E-15, 2 301.38490,6.51937E-03,8.61601E-08,4.81257E-11,1.17221E-15, 3 301.39920,6.51150E-03,8.58417E-08,4.80590E-11,1.17105E-15, 4 301.38770,6.52702E-03,8.63606E-08,4.81834E-11,1.177669E-15/ data waven/ 1 667.58,680.18,690.01,704.22,716.32,732.81,751.92,900.45, 2 1026.66,1223.44,1368.68,1478.59,2190.37,2210.51,2236.62, 3 2267.62,2361.64,2514.68,2653.48,14453.14 / data iord/1,3,4,6,16,15,10,11,20,13,8,18,5,14,17,19,2,7,9,12/ data ind/1,41/ data band/ 1 0.007,0.99996 , 0.007,0.99995 , 0.019,0.99989 , 0.026,0.99988, 2 0.021,0.99990 , 0.140,0.99964 , 0.058,0.99982 , 0.358,0.99940, 3 0.181,0.99985 , 0.377,0.99975 , 0.175,0.99992 , 0.265,0.99863, 4 0.078,1.00042 , 0.017,0.99995 , -0.023,0.99950 ,0.021,0.99995, 5 0.022,0.99997 , 0.058,0.99992 , 0.344,0.99950 / c1=1.1910659E-5 c2=1.438833 C! read in coefficients for predicting calibration coefficients open(11,file='predcoef.txt',status='old') read(11,*) do k=1,19 read(11,*) (coslope(i,k),i=1,9) enddo read(11,*) do k=1,19 read(11,*) (cointcpt(i,k),i=1,9) enddo close(11) C! initialize the slope and intercept array do i=1,43 do j=1,19 pslope(i,j)= 0.0 pintcpt(i,j)= 0.0 enddo enddo C! First get the calibration coeff for both ends of the superswath do 100 iii=1,2 ! for two ends C! initialize counts do i=1,56 do j=1,20 scount(i,j)=-9999 wcount(i,j)=-9999 enddo enddo C! assign space scan to onehir do i=1,2128 onehir(i)=suphirs(i,ind(iii)) enddo C! check the flags if(btest(nflags,25)) then print *, 'First line is not a space line!' return endif if (.not.btest(nflags,24)) then print *, 'First line is not a space line!' return endif do k=1,20 !20 channels m = iord(k) do 110 i = 1,56 imfq=mfq(i) if(btest(imfq,2)) goto 110 j = 484 + (i-1) * 22 + m scount(i,k)=onehir(j) 110 continue enddo !k=1,20 C! instrument temp count do it=1,8 sinst(it)=onehir(484 + (62*22)+it) enddo C! now the warm target count C! assign warm target scan to onehir do i=1,2128 onehir(i)=suphirs(i,ind(iii)+2) enddo awarmc = 0.0 do k=1,20 m = iord(k) do 120 i = 1,56 imfq=mfq(i) if(btest(imfq,2)) goto 120 j = 484 + (i-1) * 22 + m wcount(i,k)=onehir(j) 120 continue enddo !k=1,20 C! Add sth here, warm BB temp and instrument temp do it=1,20 warmt(it)=onehir(484 + (58*22)+it) enddo do it=1,8 winst(it)=onehir(484 + (62*22)+it) enddo C! calculate the warm BB radiance according to temperature tprtw = 0.0 do 130 i= 1,4 wsum=0.0 do 131 j=1,5 kk=(i-1)*5+j if (warmt(kk) .gt. -9999 .and. warmt(kk) .lt. 32760) then wsum=wsum+warmt(kk) endif cofw(j,i)=cofw1((i-1)*5+j) 131 continue wsum=wsum/5.0 prtw(i) = cofw(1,i) + cofw(2,i)*wsum + cofw(3,i)*wsum*wsum 1 + cofw(4,i)*wsum*wsum*wsum + cofw(5,i)*wsum*wsum*wsum*wsum tprtw=tprtw + prtw(i) 130 continue tprtw=tprtw/4.0 do k=1,19 bandc(1,k)=band((k-1)*2+1) bandc(2,k)=band(k*2) tstar(k)=tprtw * bandc(2,k) + bandc(1,k) s1 = c1*waven(k)*waven(k)*waven(k) s2 = exp( (c2* waven(k))/tstar(k)) -1 prtrad(k) = s1/s2 enddo !k=1,19 C! calculate the mean of the space count and warm count for spots 9-56 do 140 k=1,19 smean(k)=0.0 wmean(k)=0.0 ismean=0 iwmean=0 nums=0 numw=0 do i=9,56 if (scount(i,k) .gt. -9999 .and. scount(i,k) .lt. 32760) then ismean=ismean+scount(i,k) nums=nums+1 endif if(wcount(i,k) .gt. -9999 .and. wcount(i,k) .lt. 32760 ) then iwmean=iwmean+wcount(i,k) numw=numw+1 endif enddo !i=9,56 if (nums .gt. 0) then ismean= ismean/nums else print *,'nums=',nums irfail=1 return endif if (numw .gt. 0) then iwmean = iwmean/numw else print *,'numw',numw irfail=1 return endif C! Add filter here to filter out the off data in a line and redo the calculation of mean nums=0 numw=0 do i=9,56 if (scount(i,k) .gt. -9999 .and. scount(i,k) .lt. 32760 .and. 2 abs(scount(i,k)-ismean) .le. 3 ) then smean(k)=smean(k)+scount(i,k) nums=nums+1 endif if(wcount(i,k) .gt. -9999 .and. wcount(i,k) .lt. 32760 .and. 2 abs(wcount(i,k)-iwmean) .le. 3 ) then wmean(k)=wmean(k)+wcount(i,k) numw=numw+1 endif enddo !i=9,56 if (nums .gt. 0) then smean(k)= smean(k)/float(nums) else print *,'nums=',nums irfail=1 return endif if (numw .gt. 0) then wmean(k) = wmean(k)/float(numw) else print *,'numw',numw irfail=1 return endif C! Here if too many spots are thrown away, add a flag showing C! that calibration coefficients may be suspicious if (nums .le. 41 .or. numw .le. 41) then print*,'Too many spots are thrown away during calibration!!' do jl=1,40 do js=1,56 if(iii .eq. 1) then hirsdat(33,js,jl)=-1.0 else hirsdat(33,js,jl)=-2.0 endif enddo enddo endif 140 continue !k=1,19 C! Calculate slope and intercept based on above results do k=1,19 if((smean(k)-wmean(k)) .gt. 0.1) then nslope(iii,k)= (0.0 - prtrad(k))/ (smean(k) - wmean(k)) nintcpt(iii,k)= 0.0 - nslope(iii,k)*smean(k) C! print *,'slope&intcpt', k, nslope(iii,k),nintcpt(iii,k) else print *,'Sth wrong with warm BB counts or space-view counts!' irfail=1 return endif enddo C! Now predict the slope and intercept from instrument temperatures and C! get the differences between calculated and predicted coefficients do i=1,8 if(winst(i) .gt. 0 .and. winst(i) .lt. 32760 .and. 2 sinst(i) .gt. 0 .and. sinst(i) .lt. 32760) then ainst(i)=(winst(i)+sinst(i))/2.0 else print *,'wsinst',winst(i),sinst(i) print *,'Sth wrong with instrument temperatures!' irfail=1 return endif enddo do 150 k=1,19 C! slope pslope(iii,k)=0 do j=1,8 pslope(iii,k)=pslope(iii,k)+ coslope(j+1,k)*ainst(j) enddo pslope(iii,k)=pslope(iii,k)+coslope(1,k) C! print *,'pslope',pslope(iii,k) difslope(iii,k)=(nslope(iii,k)-pslope(iii,k)) C! intercept pintcpt(iii,k)=0 do j=1,8 pintcpt(iii,k)= pintcpt(iii,k)+cointcpt(j+1,k)*ainst(j) enddo pintcpt(iii,k) = pintcpt(iii,k)+ cointcpt(1,k) C! print *,'pintcpt',pintcpt(iii,k) difintcpt(iii,k)=(nintcpt(iii,k)-pintcpt(iii,k)) 150 continue 100 continue C! End of calculate calibration at two ends of the Superswath R!C C! Now get the calibration for all the scanlines C! First move the cali from 2 to 41 do k=1,19 pslope(41,k) = pslope(2,k) pintcpt(41,k) = pintcpt(2,k) enddo do 160 is=4,40 ! all 37 earth-view scans do i=1,2128 onehir(i)=suphirs(i,is) enddo C! instrument temp count do it=1,8 sinst(it)=onehir(484 + (62*22)+it) C! print *,'sinst',it, sinst(it) if(sinst(it) .lt. 0 .or. sinst(it) .gt. 32760) then print *,'Something wrong with sinst! Calibration coefficients for 2 this scan will be zero!' goto 160 endif enddo !it=1,8 do k=1,19 C! slope pslope(is,k)=0.0 do j=1,8 pslope(is,k)=pslope(is,k)+ coslope(j+1,k)*sinst(j) enddo pslope(is,k)=pslope(is,k)+coslope(1,k) C! do some adjustment according to the difference at two ends pslope(is,k)=pslope(is,k)+difslope(1,k) pslope(is,k)=pslope(is,k)+(difslope(2,k)-difslope(1,k)) . *((is-2)/40.0) C! intercept pintcpt(is,k)=0.0 do j=1,8 pintcpt(is,k)= pintcpt(is,k)+cointcpt(j+1,k)*sinst(j) enddo pintcpt(is,k) = pintcpt(is,k)+ cointcpt(1,k) C! do some adjustment according to the difference at two ends pintcpt(is,k)=pintcpt(is,k)+difintcpt(1,k) pintcpt(is,k)=pintcpt(is,k)+(difintcpt(2,k)-difintcpt(1,k)) . *((is-2)/40.0) C! print *,pslope(is,k),pintcpt(is,k) enddo ! k=1,19 160 continue C! Fill the other ends scans do k=1,19 do is=2,3 pslope(is,k)=pslope(1,k) pintcpt(is,k)=pintcpt(1,k) enddo do is=42,43 pslope(is,k)=pslope(41,k) pintcpt(is,k)=pintcpt(41,k) enddo enddo end C****************** end of calibration*************************** function brightn(r,k) C! changed for only converting NOAA-12 radiances to brightness temperature, not adjusted. c c*********************************************************************** c c name- bright c c language- forthxp type- function c c version-1.1 date- 9/15/77 programmer- fu, c.c. c c function- converts radiance(mw/(m*m*sr/cm)) to brightness c temperature (K). c c parameters- c variable type i/o function c -------- ---- --- -------- c r r*4 i radiance c k i*4 i channel number c c key local parameters- c variable type function c -------- ---- -------- c bndcor(2,27) r*4 band correction coefficients c fk1(27) r*4 =2*h*c*c*v*v*v c fk2(27) r*4 =h*c*v/b, where c v=wave number of a channel c c=velocity of light c h=planck constant c b=boltzmann constant c c subprograms called - none c c restrictions- input radiance should be screened before calling this routine c c common areas- procfl c c*********************************************************************** c---------------------------------------------------------------------- c c *** common procfl *** c c common -procfl date -01/13/78 programmer - m. chalfant (ness) c function - transfers first group coefficients from cdb. c used by - limb,msucof,co2vtc,bright,cldcof,parmrd,ozcon, c co2,h2o,ssucof,ozcof,interp,tranh,ozconv,trnh2o,planck, c lmcorm,lmcorh,lmcors,co2ztc,ssuvtc,ssuztc,tmsu1,antmsx, c regabs,msulbl,msureg,msuver,h2oreg,tropo,hirrad,oztau, c co2tau,ssutau,trncon,radex,ssurad,chkhse,rd6a6b,cprtlo, c cprthi,cprwv,fndssu,cprttp,cprpwv,storad,$tprps,bright c comlnk,getcdb,gtcalh,gtcalm,gtcals,gthir,hircal,hirlim c hir8lm,lstsqs,msucal,msulim,obrej,plank,readlm,print c c real*4 ssulc(7,3,4,2),wvno(27),bandw(27),bndcor(2,27), c 1 fk1(27),fk2(27),pret(40),hight,ssuscl(3),ssufug(9,3), c 2 sigman(27),sigpro(27),gamt(27),asmsu(4,11),slope(6), c 3 cept(6),fax(27),dum1(462) c integer*4 mvmsuo(27),mvsclr(27),mvmsul(27),mvs3l(27),mvs3o(27), c 1 mvshir(27),mvshot(27),mvshi3(27),mvshic(27),msuhi(27), c 2 ifgmvs,ishan(2,3),iprofl(200),nlevs,nwlevs,nhatm,nmatm,nhc,nmc, c 3 nsc,norej(100) c c common / procfl / ssulc,wvno,bandw,bndcor,fk1,fk2,pret,hight, c 1 ssuscl,ssufug,sigman,sigpro,gamt,asmsu,slope,cept,fax,dum1, c 2 mvmsuo,mvsclr,mvmsul,mvs3l,mvs3o,mvshir,mvshot,mvshi3,mvshic, c 3 msuhi,ifgmvs,ishan,iprofl,nlevs,nwlevs,nhatm,nmatm, c 4 nhc,nmc,nsc,norej c C! include '../tovsoper/common/procfl.cmn1' real*4 waven(20) data waven/ 1 667.58,680.18,690.01,704.22,716.32,732.81,751.92,900.45, 2 1026.66,1223.44,1368.68,1478.59,2190.37,2210.51,2236.62, 3 2267.62,2361.64,2514.68,2653.48,14453.14 / c1=1.1910659E-5 c2=1.438833 wv=waven(k) expn=c1*wv*wv*wv/r+1. brightn=c2*wv/alog(expn) return end subroutine gethirs C! C! ***This version is for big endian platforms!!! C! If used on little endian machine, need some switch on C! variables associated with equivalence. C******************************************************************* C! This subroutine calculates the HIRS BT for C! one superswath of data 010912 C! called by: tvoprn.f, hirsbt.f C! modified, add some check 010918 C! modified for deal with 40 line superswath 011003 C! Add some filter for space & warm BD count data 011018 C! Add channel 20 into process ans hirsdat 011023 C! Change to handle bad superswath, let irfail=1 return 011101 C! modified the adjustment with calculated coefficients 38-40 C! C******************************************************************* c*************************************************************** c key local parameters- c variable type function c -------- ---- -------- c band,bandc real Temperature correction coeff c the attached is NOAA12's c iord int*2 The order of channels in Level 1b data c mfq logical*1 Quality info of spot data c onehir int*2 One scanline of 1b data c mclcf,nrmcf int*2 Original calibration info saved in Level 1b data c clcfh,rmcfh real*4 Calibration coefficient from mclcf,nrmcf c nflags int*4 Scan quality flag c pslope, pintcpt real*4 New calibration coeff for a superswath c c*************************************************************** c* include 'superdata.cmn' include 'toohi.cmn' real*4 band(38),bandc(2,19) integer*2 iord(20) integer*2 nfl(2) logical*1 mfq(56) integer*4 jyr,jday,jhr,jmn,jsec,msec,nflags integer*2 onehir(2128) integer*4 mclcf(3,20),nrmcf(3,20) real*4 clcfh(3,20),rmcfh(3,20) real*4 pslope(43,19),pintcpt(43,19) real*4 pslp,picpt equivalence (nflags,nfl(1)),(mfq(1),onehir(1891)) real*4 scale(3) data scale/4.194304e6,1.0737418e9,1.7592186e13/ equivalence (mclcf(1,1),onehir(129)),(nrmcf(1,1),onehir(249)) data iord/1,3,4,6,16,15,10,11,20,13,8,18,5,14,17,19,2,7,9,12/ data band/ 1 0.007,0.99996 , 0.007,0.99995 , 0.019,0.99989 , 0.026,0.99988, 2 0.021,0.99990 , 0.140,0.99964 , 0.058,0.99982 , 0.358,0.99940, 3 0.181,0.99985 , 0.377,0.99975 , 0.175,0.99992 , 0.265,0.99863, 4 0.078,1.00042 , 0.017,0.99995 , -0.023,0.99950 ,0.021,0.99995, 5 0.022,0.99997 , 0.058,0.99992 , 0.344,0.99950 / C! first get the calibration ********************************* call newhirscali(pslope,pintcpt) C! init the output array of HIRS data do k=1,40 do j=1,56 do i=1,35 hirsdat(i,j,k)=-9999.9 enddo hirsdat(1,j,k)=-1.0 !flags hirsdat(33,j,k)=1.0 !Cali flags enddo enddo C! The temp correction coefficients do k=1,19 bandc(1,k)=band((k-1)*2+1) bandc(2,k)=band(k*2) enddo C! print *,'bandc=',bandc(1,k),bandc(2,k) do 120 is=1,40 !40 scanlines do i=1,2128 onehir(i)=suphirs(i,is) enddo C! nflags ***if little endian switch 1 & 2 nfl(1)=onehir(5) nfl(2)=onehir(6) C! first check the scan quality if(btest(nflags,31)) goto 120 call tme1b(onehir(2),onehir(3),onehir(4),jyr,jday,jhr, . jmn,jsec,msec) C! print *,'hirs time',jhr,jmn,jsec C! pull the original calibration info out of the dataset C! If little endian platform, do switching bytes C! do ik=1,180 C! ntrans=onehir(8+ik*2) C! onehir(8+ik*2)=onehir(8+ik*2-1) C! onehir(8+ik*2-1)=ntrans C! enddo C! print *, 'cali info from data:' do j=1,20 c... find the corresponding radiometric channel number k=iord(j) do im=1,3 rmcfh(im,j)=nrmcf(im,k)/scale(im) enddo C! print*,(rmcfh(im,j),im=1,3) enddo do j=1,20 k=iord(j) do im=1,3 clcfh(im,j)=mclcf(im,k)/scale(4-im) enddo C! PRINT *,(clcfh(im,j),im=1,3) enddo C! Since we only need ch20's info, ignore the correction of C! calibration for chan 1&2 C! c ===================================================== c... loop thru 56 spots in HIRS line c for each spot check for mirror sequence error, c then loop through 20 channels and extract data. c convert the data to radiances and then to temps. c ===================================================== do 110 i=1,56 c... check mirror sequence error flag imfq=mfq(i) if (btest(imfq,2)) go to 90 c... loop thru 20 channels for each spot do 80 k=1,19 c... find corresponding radiometric channel number m=iord(k) j=484+(i-1)*22+m c... check for missing data if (onehir(j).eq.ifill) go to 90 c... calculate radiance c=onehir(j) pslp=pslope(is,k) picpt=pintcpt(is,k) C! print *,'slope&intecept', is, k,pslp,picpt r=c*pslp+picpt if (is .eq. 1) then temp=r ! save radiance instead of BT for space view go to 80 endif C! if (is .gt. 3) print *, 'is,k,r',is,k,r if (r .le. 0. ) go to 90 temp=brightn(r,k) temp =(temp-bandc(1,k))/bandc(2,k) C! C! if (is .gt. 3) print *, 'BT from HIRS:',temp C! check the bt with limits if(temp.lt.tooloh(k).or.temp.gt.toohih(k)) go to 90 C! assign temperature to the output array 80 hirsdat(8+k,i,is)=temp C! ADD channel 20's processing here, use original calibration data C! calculate chan 20 albedo m=iord(20) j=484+(i-1)*22+m c... check for missing data if (onehir(j).eq.ifill) go to 110 !bad of ch20 will not affect other channel c... calculate radiance cc=onehir(j) C! print *, 'chan20 cc',i,cc c=rmcfh(1,20)+cc*(rmcfh(2,20)+cc*rmcfh(3,20)) r=c*(clcfh(1,20)*c+clcfh(2,20))+clcfh(3,20) ! print *, 'chan20 r',i,r,clcfh(1,20),clcfh(2,20),clcfh(3,20) if (r.lt.0.) r=0. hirsdat(8+20,i,is)=r CCCCC ch20 added C! assign different flags according to view if( is .eq. 1) then hirsdat(1,i,is)=2.0 else if( is .eq. 2) then hirsdat(1,i,is)=3.0 else if( is .eq. 3) then hirsdat(1,i,is)=4.0 else hirsdat(1,i,is)=1.0 endif hirsdat(2,i,is)=onehir(369+i*2)/128. !lat hirsdat(3,i,is)=onehir(370+i*2)/128. !lon hirsdat(4,i,is)=jyr !yrar hirsdat(5,i,is)=jday !day hirsdat(6,i,is)=msec !utc time hirsdat(7,i,is)=onehir(369) !height hirsdat(8,i,is)=onehir(370)/128. !local zenith angle goto 110 90 do k=1,20 ! if a channel is bad, every channel bad, including previous hirsdat(8+k,i,is)=-9999.0 enddo 110 continue 120 continue C! may do some output here? end subroutine i2move(target,len,source) integer*2 target(len),source(len) do 10 i=1,len target(i) = source(i) 10 continue return end subroutine rdhdr(insdd,idtatp,len1b,numsk,numdg,iendtm,insprt, 1 satid) c c********************************************************************** c c name- rdhdr expires- 12/31/99 c c language- fortran type- subroutine c c version- 1.0 date- 11/22/82 programmer- frank carr (sasc) c c function-*$sd30fc* This subroutine will read the HIRS, MSU, and SSU c Level 1b dataset header records. It will check the header record c length, date, data type, and satellite id. If any of the checks c fail processing is returned to gthrd with iconfg set to less c than 100. This will eventually lead to a stop 4 execution c terminate in the preprocessor. If all of the checks pass, several c data items from header are passed to the common area headrc. c c parameters- c variable type i/o function c -------- ---- --- -------- c insdd i*4 i the instrument 1b dataset ddname c idtatype i*2 i the instrument/satellite data c type. hirs = 5. msu = 6. ssu = 7 c len1b i*2 i the length of the 1b dataset c header record c numsc i*2 o number of scan lines c numdg i*2 o number of data gaps c iedtim i*2 o the ending time of the header c record c insprt l*4 i the dataset name to be printed c for error messages c iextim i*4 i the beginning execution time c for mstat texec c icktim i*4 i the check time for a current c header record c c files- c dsn or descriptive title i/o unit functional description c ------------------------ --- ---- ---------------------- c (dynamically allocated) i HIRS 1b dataset c (dynamically allocated) i MSU 1b dataset c (dynamically allocated) i SSU 1b dataset c c key local parameters- c variable type function c -------- ---- -------- c hdrbuf(2127) i*2 buffer for storage of header record c len i*2 the length returned from ffget c idate1,idate2,idate3 i*2 the 6 byte date from the header c record c formhd i*2 the format of the date to be c supplied to clue routine urdate c mask1 i*2 mask used to find instrument id c numck i*2 number of scan lines in dataset c numdg i*2 number of data gaps in dataset c iendtm i*2 the ending time from the dataset c header c iyr i*4 the year from tme1b c idy,ihr i*4 the day and hour of day from tme1b c ijuldt i*4 the julian date obtained by c modifying the dates returned from c tme1b c ichrdy(37) i*4 the various form of the Christian c day returned from urdate c irc i*4 the return code from urdate c ihdtm i*4 the hour date and time of the c header record c c subprograms called- urdate,tme1b,fmove,frwnd c c exit states- returns to gthrd c c common areas- conflg,inbuf,headrc,mstat c c block datas- units,printc c c********************************************************************** c c rdhdr version 1.0 fc begun 11/22/82 completed 12/20/82 cllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll logical*4 insprt integer*4 insdd,iyr,idy,ihr cl integer*4 insdd(2),iyr,idy,ihr,icktim,iextim integer*4 ihdtm,len1b,ijuldt integer*4 jstat integer*2 hdrbuf(2128),idate1,idate2,idate3,idtatp integer*2 mask1/'Z00F0'/,numsk,numdg,iendtm(3),satid c c*** initialize variables *** c numsk = 0 numdg = 0 iendtm(1) = 0 iendtm(2) = 0 iendtm(3) = 0 c print *,'before reading....' read(insdd,rec=1,iostat=jstat) hdrbuf cl print *, hdrbuf C! print *,'head info' C! print *,hdrbuf(0),hdrbuf(1),hdrbuf(2) cllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll call i2move(idate1,1,hdrbuf(2)) call i2move(idate2,1,hdrbuf(3)) call i2move(idate3,1,hdrbuf(4)) cl cl call i2move(idate1,2,hdrbuf(2)) cl call i2move(idate2,2,hdrbuf(3)) cl call i2move(idate3,2,hdrbuf(4)) c c*** obtain the time from the header from subroutine tme1b *** c*** then convert this date into a julian date, then to a *** c*** Christian date. *** c call tme1b(idate1,idate2,idate3,iyr,idy,ihr,imn,isec,msec) print *,'HEAD time' print *,iyr,idy,ihr,imn,isec,msec c pause ijuldt = (iyr*1000) + idy ihdtm = (ijuldt*100) + ihr C! satid = hdrbuf(1)/256 c c 50 satid = hdrbuf(1)/256 100 return end subroutine readlm c c********************************************************************** c c name- readlm c c language- fortran type- subroutine c c version- 1.0 date- 06/13/80 programmer- domm c version- 2.0 date- 03/01/83 programmer- frank carr (sasc) c c function- read allowed temperature limits for HIRS, MSU, and c SSU and convert to radiance limits c c files- c dsn or descriptive title i/o unit functional description c ------------------------ --- ---- ---------------------- c nss.dpss.tovs.data(prelm i 37 raw temperature limits for c input to preprocessor c c key local parameters- c variable type function c -------- ---- -------- c ifi i*4 fortran file unit number c toohih r*4 hirs upper radiance limits c tooloh r*4 hirs lower radiance limits c toohim r*4 msu upper radiance limits c toolom r*4 msu lower radiance limits c toohis r*4 ssu upper radiance limits c toolos r*4 ssu lower radiance limits c i i*4 concatonated channel number c k i*4 channel number c c common areas- toohi,procfl c c********************************************************************** c c readlm1 version 2.0 fc begun 03/11/83 completed 03/11/83 c c *** first read the upper and lower limits for *** c *** the HIRS, MSU and SSU temperature limits *** c include 'toohi.cmn' ifi=37 cl open(ifi, file='PRELMS3.dat', status='old') cl read (ifi,1010) (toohih(k),k=1,20) read (ifi,1010) (tooloh(k),k=1,20) read (ifi,1020) (toohim(k),k=1,4) read (ifi,1020) (toolom(k),k=1,4) read (ifi,1030) (toohis(k),k=1,3) read (ifi,1030) (toolos(k),k=1,3) c write (*,1010) (toohih(k),k=1,20) c write (*,1010) (tooloh(k),k=1,20) c write (*,1020) (toohim(k),k=1,4) c write (*,1020) (toolom(k),k=1,4) c write (*,1030) (toohis(k),k=1,3) c write (*,1030) (toolos(k),k=1,3) c c *** now convert the temperature limits to radiances *** c *** channel 20 need not be converted as the limits *** c *** are 0,0 *** cl do 1000 k=1,19 cl toohih(k)=planck(toohih(k),k) cl tooloh(k)=planck(tooloh(k),k) cl if (k.gt.4) go to 1000 cl i=k+20 cl toohim(k)=planck(toohim(k),i) cl toolom(k)=planck(toolom(k),i) cl if (k.gt.3) go to 1000 cl i=k+24 cl toohis(k)=planck(toohis(k),i) cl toolos(k)=planck(toolos(k),i) cl 1000 continue c return c 1010 format (14(f4.0,1x),/,6(f4.0,1x)) 1020 format (4(f4.0,1x)) 1030 format (3(f4.0,1x)) end subroutine tme1b(icode1,icode2,icode3,iyr,idy,ihr,imn, . isec,nsec) c c********************************************************************** c c name- tme1b expires- 12/31/99 c c language- fortran type- subroutine c c version- 1.0 date- 03/30/83 programmer- alice filemyr bell c version- 2.o date- 06/28/87 programmer- s. chattopadhyay c c function-*$sd30fc* repack time from 1b dataset format. c c This program was transferred from tovs lib. to klmv lib. by c s. k. chattopadhyay on 06/28/87. This program is used without c any modification. c c parameters- c variable type i/o function c -------- ---- --- -------- c icode1,icode2,icode3 i*4 i the first three words c containing the time in Level 1b c dataset format c iyr i*4 o year c idy i*4 o day c ihr o o hour c imn i*4 o minutes c sec i*4 o seconds c c common areas- (none) c c block data- (none) c c********************************************************************** cl integer*2 icode1,icode2,icode3,idum(2),it(2) integer*4 itemp,isec,iyr,mnday equivalence (msec,idum(1)) equivalence (itemp,it(1)) itemp=0 idum(1)=icode2 idum(2)=icode3 mnday=msec/60000 idyyr=icode1 it(2)=icode1 iyr = ishft(itemp,-9) it(2)=icode1 itemp =ishft(itemp,23) idy = ishft(itemp,-23) nsec = msec c it(2) = 0 c it(1) = icode1 c iyr = ishft(itemp, -9) c it(1) = icode1 c itemp = ishft(itemp, 7) c idy = ishft(itemp, -7) ihr=msec/3600000 msec=msec-ihr*3600000 imn=msec/60000 msec=msec-imn*60000 cl sec=float(msec)/1000.0 isec=(msec)/1000 cl cl call ymdjdt(iyr,imo,idy) cl iyrmo=iyr*100 + imo cl idyhr=idy*100 + ihr cl imnsc=imn*100 + isec cl print *, 'iyrmo,idyhr,imnsc,mnday',iyrmo,idyhr,imnsc,mnday cl julmin=mnday+(idy-1)*minday cl return end
| Previous Section | Top of Page |