NASA Ocean Color

ocssw V2022
 c  This program reads a 22180-byte SeaWiFS formatted record and compresses
 c  the S/C ID, time tag, instrument telemetry and scan line data from 2-byte
 c  words to 10 bits.  The data are written in 13860-byte records formatted
 c  as SeaWiFS minor frames.  The leading and trailing frame synch words are
 c  filled with zeros.  
  
         integer*2 ints(4),isync
         integer*4 irec
         byte inbuf(512),inrec(22180),outrec(13860),b10(5),bint(8)
         byte frsync(7),ausync(125)
         character*50 l0file
         character*50 outfile
         data outrec/13860*0/,ints/4*0/
         data isync/5/
         data frsync/z'a1',z'16',z'fd',z'71',z'9d',z'83',z'c9'/
         data ausync/
      *   z'f8',z'bf',z'36',z'd6',z'bd',z'a1',z'11',z'57',z'11',z'd3',
      *   z'd0',z'4e',z'0a',z'db',z'de',z'37',z'19',z'9f',
      *   z'c9',z'93',z'a3',z'86',z'90',z'fb',z'63',
      *   z'12',z'c9',z'55',z'02',z'd5',z'a7',z'24',z'5d',
      *   z'88',z'6d',z'29',z'ba',z'df',z'f8',z'3b',
      *   z'f7',z'4b',z'67',z'34',z'c5',z'bb',z'd6',z'7b',
      *   z'00',z'42',z'60',z'ce',z'ed',z'4a',z'ea',
      *   z'76',z'63',z'd4',z'68',z'06',z'35',z'0a',z'99',
      *   z'be',z'f9',z'f4',z'd5',z'23',z'e5',z'c0',
      *   z'52',z'f8',z'fd',z'56',z'18',z'50',z'eb',z'fb',
      *   z'21',z'72',z'07',z'b8',z'48',z'3f',z'd1',
      *   z'47',z'89',z'e0',z'6b',z'1c',z'b0',z'46',z'46',
      *   z'c2',z'03',z'9e',z'44',z'd1',z'05',z'e9',
      *   z'2e',z'86',z'56',z'5a',z'30',z'25',z'16',z'6b',
      *   z'98',z'71',z'db',z'9c',z'57',z'd7',z'72',
      *   z'83',z'79',z'd5',z'e5',z'44',z'93',z'65',z'27',z'c3',z'cc'/
  
         equivalence(ints,bint)
  
         write(*,*) 'Enter Level 0 file name'
         read (5,'(a50)') l0file
         write(*,*) 'Enter Output file name'
         read (5,'(a50)') outfile
  
         open(unit=11,file=l0file,access='direct',recl=22180,
      *    status='old',action='READ')
         open(unit=12,file=outfile,access='direct',recl=13860)
  
 c  Initialize output record with frame and auxillary synchs 
         do i=1,7
           outrec(i) = frsync(i)
         end do
         do i=1,125
           outrec(i+13735) = ausync(i)
         end do
  
 c  Skip header records
         nrec = 0
         irec = 2
  
 c  Now loop through input records
       dowhile(.true.)
  
 c  Read a complete L0 record
         read (11,err=999,rec=irec) inrec
         irec = irec + 1
         nrec = nrec + 1
  
 c  Reverse bytes (not needed for linux)
 c        do i=1,22180,2
 c            bval       = inrec(i)
 c            inrec(i)   = inrec(i+1)
 c            inrec(i+1) = bval
 c        enddo
         
 c  Remaining 10-bit data (instrument telemetry and scan line) 
         do l=1,2772
           do i=1,8
             bint(i) = inrec(i+(l-1)*8)
           end do
           call i2to10bit(ints,b10)
           do i=1,5
             outrec(i+(l-1)*5) = b10(i)
           end do
         end do
  
         write (12,rec=nrec) outrec
  
         if (mod(nrec,100) .eq. 0) then
             write(*,*) 'Writing record ',nrec
 c            goto 999
         endif
  
       end do
  
   999 continue
  
       stop
       end
  
         subroutine i2to10bit(ints,bit10)
  
 c  This subroutine compresses a 4-element I*2 array into a 5-element byte 
 c  array, taking the 10 least significant bits of each integer.  
  
         integer*2 ints(4)
         byte bit10(5)
         integer*2 m3fc,m003,m3f0,m3c0,m300,m00f,m03f,m0ff
         data m3fc/1020/,m003/3/,m3f0/1008/,m00f/15/
         data m3c0/960/,m03f/63/,m300/768/,m0ff/255/
         bit10(1) = iand(ints(1),m3fc)/4
         bit10(2) = iand(ints(1),m003)*64 + iand(ints(2),m3f0)/16
         bit10(3) = iand(ints(2),m00f)*16 + iand(ints(3),m3c0)/64
         bit10(4) = iand(ints(3),m03f)*4  + iand(ints(4),m300)/256
         bit10(5) = iand(ints(4),m0ff)
         return
         end
i2to10bit
subroutine i2to10bit(ints, bit10)
Definition: ql02raw.f:98