c  ***************************************************************
c  *  Registers AVIRIS images                                    *
c  *                                                             *
c  *  set band to -1 for Band Interleaved by Line (BIL) copy     *
c  *  set band to band number to copy single band from BIL file  *
c  *    band ignored when input file is a single band,fcb(13)=1  *
c  *                                                             *
c  *  To change flightline array length, change lines:           *
c  *    INTEGER*4  regbuf(1014,6544), maxsl=6144 + (2*offset),   *
c  *    slpos(1014,6544), and pxpos(1014,6554)                   *
c  *    This size is set for 12 (512sl) AVIRIS Seg's now         *
c  *                                                             *
c  *  K. Eric Livo     Sept. 1997                                *
c  ***************************************************************
      INTEGER*4 inimg(256), outimg(256), pixoff(256), sloff(256)
      INTEGER*4 offset, maxpix, maxsl, dnempty, curpix, cursl
      INTEGER*2 inbuf(1014,6544), outbuf(8192)
      INTEGER*2 pixbuf(8192), slbuf(8192)

      DATA pixoff,sloff/3*0,2*1,251*0,3*0,2*1,251*0/
      DATA inimg,outimg/3*0,2*1,251*0,3*0,2*1,251*0/

      offset = 200
      maxsl = 6144 + (2*offset)
      maxpix = 614 + (2*offset)


      CALL REMLOG('=========== AVRECTFY ===========')

c     inimg(1)=0 open read only (pc: to implement); 
c     inimg(1)=-1 open read/write

c  open input (unregistered) image
c   assuming single band input only at this point (No 0 0 0 -1)
      inimg(1) = 0
      write(*,*) 'Enter INPUT IMAGE FILENAME'
      CALL DISKIO(0,10,inbuf,inimg)
      IF(inimg(1).LT.0) CALL EXIT(3)

c  open scanline offset image
      sloff(1) = 0
      write(*,*) 'Enter SCANLINE LOOKUP FILENAME'
      CALL DISKIO(0,11,slbuf,sloff)
      IF(sloff(1).LT.0) CALL EXIT(3)

c  open pixel offset image
      pixoff(1) = 0
      write(*,*) 'Enter PIXEL LOOKUP FILENAME'
      CALL DISKIO(0,12,pixbuf,pixoff)
      IF(pixoff(1).LT.0) CALL EXIT(3)

c  open rectified output image (using AVIRIS engineering data)
      if(inimg(22).gt.1) then
      CALL DISKIO(0,13,outbuf,outimg)
      IF(outimg(1).LT.0) CALL EXIT(3)

C  *****
c  assuming pixel-offset image, and scanline-offset image
c  are the same dimensions for now, just register single band inputs
c  not testing for BIL either
C  *****

c  read input image
c  not testing for, but assume single band for now

      cursl = 1

      do while (inimg(1).ge.0)
         CALL DISKIO(9,10,inbuf(1,cursl),inimg)
c        IF(inimg(1).EQ.-1) GOTO 2
         IF(inimg(1).LT.-1) CALL EXIT(3)
         CALL UNPACK(inbuf(1,cursl),inimg)
         cursl = cursl + 1

c  sloff(2)=max pixels in subset image
c  sloff(3)=max scanlines in subset image

      do 100, cursl=1,sloff(3)

c  read scanline and pixel lookup images
         CALL DISKIO(9,11,slbuf,sloff)
         IF(sloff(1).EQ.-1) GOTO 999
         IF(sloff(1).LT.-1) CALL EXIT(3)
         CALL UNPACK(slbuf,sloff)

         CALL DISKIO(9,12,pixbuf,pixoff)
         IF(pixoff(1).EQ.-1) GOTO 999
         IF(pixoff(1).LT.-1) CALL EXIT(3)
         CALL UNPACK(pixbuf,pixoff)

c  plot image DN using orig image and lookup images

         do 110, curpix=1,sloff(2)
            lookuppx = pixbuf(curpix)
            lookupsl = slbuf(curpix)
            if( (
     &          (lookuppx.le.inimg(2)).and.
     &          (lookuppx.le.maxpix).and.
     &          (
     &          (lookupsl.le.inimg(3)).and.
     &          (lookupsl.le.maxsl) ) then
               outbuf(curpix) = inbuf(lookuppx,lookupsl)
               outbuf(curpix) = dnempty
110      enddo

c  write rectified output

         IF(outimg(25).EQ.8) CALL PACK(outbuf,outimg)
         CALL DISKIO(10,13,outbuf,outimg)
         IF(outimg(1).LT.0) CALL EXIT(4)

100   enddo

c  close all files

999   CALL DISKIO(6,10,inbuf,inimg)
      CALL DISKIO(6,11,slbuf,sloff)
      CALL DISKIO(6,12,pixbuf,pixoff)
      CALL DISKIO(6,13,outbuf,outimg)


U.S. Geological Survey, a bureau of the U.S. Department of the Interior
This page URL=
This page is maintained by: Eric Livo
Last modified December 16, 1998.