NOAA Polar Orbiter Data User's Guide

Appendix M

Blue line drawn across page to separate text from document title.
Image denotes media you're currently using--Web or CD.Introduction Page, NOAA POD Guide TOC, Acronyms,
Previous Section

APPENDIX M: New HIRS Calibration Procedure (NOAA-12 only)

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
 

Amended January 24, 2002


Previous Section Top of Page