interface to integer*4 function
     & GetBuffer [c,alias:'_GetBuffer'] (dword,flag)
      integer*4 dword
      integer*1 flag
      end
      interface to subroutine doclean [c,alias:'_DoClean']
     & (buffer,iswitch)
      byte buffer [reference]
      integer*1 iswitch [value]
      end


      subroutine doclean(buffer,iswitch)
      parameter (mwid=200,mhih=160)
      byte buffer(*)
      byte line(2,mwid)
      integer*1 iswitch
      integer ish,bot,top,kernel(3,3)
      save kernel,ish
      data kernel / 0, 0, 0,
     &              0, 1, 0,
     &              0, 0, 0/
      if(iswitch.eq.1) then
         write(6,*) ' Enter kernel as 3x3 matrix'
         read(5,'(3i1)') kernel
         write(6,'(1x,3i1)') kernel
         isum = 0
         do i=1,3
            isum = isum+kernel(1,i)
            isum = isum+kernel(2,i)
            isum = isum+kernel(3,i)
         end do
         ish = 0
         if(isum.ge.2) ish = 1
         if(isum.ge.4) ish = 2
         if(isum.ge.8) ish = 3
         if(isum.ge.16) ish = 4
      endif
      bot = 1
      top = 2
      do i=2,mhih-1
         ioff1 = (i-2)*mwid
         ioff2 = ioff1+mwid
         ioff3 = ioff2+mwid
c        line(top,1) = buffer(ioff2+1)
c        line(top,mwid) = buffer(ioff3)
c        do j=2,mwid-1
c           ival = buffer(ioff1+j-1)*kernel(1,1) +
c    &             buffer(ioff1+j)  *kernel(2,1) +
c    &             buffer(ioff1+j+1)*kernel(3,1) +
c    &             buffer(ioff2+j-1)*kernel(1,2) +
c    &             buffer(ioff2+j)  *kernel(2,2) +
c    &             buffer(ioff2+j+1)*kernel(3,2) +
c    &             buffer(ioff3+j-1)*kernel(1,3) +
c    &             buffer(ioff3+j)  *kernel(2,3) +
c    &             buffer(ioff3+j+1)*kernel(3,3)
c           line(top,j) = ishft(ival,ish).and.#FF
c        end do
c        do j=1,mwid
c           buffer(ioff1+j) = line(bot,j)
c           if(i.eq.mhih-1) buffer(ioff2+j) = line(top,j)
c        end do
c        if(top.eq.1) then
c           bot = 1
c           top = 2
c        else
c           bot = 2
c           top = 1
c        endif
      end do
      do j=1,mwid
         buffer(ioff2+j) = j.and.#FF
         buffer(ioff3+j) = j.and.#FF
      end do
      end


      integer*4 function GetBuffer(length,flag)
      integer*4 length
      integer*1 flag
      byte buffer1[allocatable,huge] (:)
      byte buffer2[allocatable,huge] (:)
      byte buffer3[allocatable,huge] (:)
      byte buffer4[allocatable,huge] (:)
      byte buffer5[allocatable,huge] (:)
      byte buffer6[allocatable,huge] (:)
      byte buffer7[allocatable,huge] (:)
      byte buffer8[allocatable,huge] (:)
      integer error,icall
      save icall
      data icall /0/
      if(flag.eq.1) goto 100
      icall = icall+1
      GetBuffer = -1
      if(icall.eq.1) then
         allocate(buffer1(length),stat=error)
         if(error.ne.0) return
         GetBuffer = LOCFAR(buffer1(1))
      else if(icall.eq.2) then
         allocate(buffer2(length),stat=error)
         if(error.ne.0) return
         GetBuffer = LOCFAR(buffer2(1))
      else if(icall.eq.3) then
         allocate(buffer3(length),stat=error)
         if(error.ne.0) return
         GetBuffer = LOCFAR(buffer3(1))
      else if(icall.eq.4) then
         allocate(buffer4(length),stat=error)
         if(error.ne.0) return
         GetBuffer = LOCFAR(buffer4(1))
      else if(icall.eq.5) then
         allocate(buffer5(length),stat=error)
         if(error.ne.0) return
         GetBuffer = LOCFAR(buffer5(1))
      else if(icall.eq.6) then
         allocate(buffer6(length),stat=error)
         if(error.ne.0) return
         GetBuffer = LOCFAR(buffer6(1))
      else if(icall.eq.7) then
         allocate(buffer7(length),stat=error)
         if(error.ne.0) return
         GetBuffer = LOCFAR(buffer7(1))
      else if(icall.eq.8) then
         allocate(buffer8(length),stat=error)
         if(error.ne.0) return
         GetBuffer = LOCFAR(buffer8(1))
      else
         return
      endif
      write(6,'(a,z10)') ' GetBuffer:',GetBuffer
      return
 100  continue
      deallocate(buffer1,stat=error)
      deallocate(buffer2,stat=error)
      deallocate(buffer3,stat=error)
      deallocate(buffer4,stat=error)
      deallocate(buffer5,stat=error)
      deallocate(buffer6,stat=error)
      deallocate(buffer7,stat=error)
      deallocate(buffer8,stat=error)
      end

c
c  The following FFT code is from:
c
c  Arthur Wouk (wouk@brl-vgr)
c
c  *******************
c  Fast Fourier Transform
c  *******************
c
        SUBROUTINE FFT (X, N, K)
C       FFT COMPUTES THE (FAST) FOURIER TRANSFORM OF THE VECTOR X
C       (A COMPLEX ARRAY OF DIMENSION N). SOURCE: Ferziger; Numerical
C       methods for engineering applications.
C
C       X = DATA TO BE TRANSFORMED; ON RETURN IT CONTAINS THE TRANSFORM.
C       N = SIZE OF VECTOR. MUST BE A POWER OF 2 (<32769).
C       K = 1 FOR FORWARD TRANSFORM.
C       K = -1 FOR INVERSE TRANSFORM.
C
        IMPLICIT INTEGER (A-Z)
        INTEGER SBY2,S
        REAL GAIN, PI2, ANG, RE, IM
        COMPLEX X(N), XTEMP, T, U(16), V, W
        LOGICAL NEW
        DATA    PI2,GAIN,NO,KO /6.283185307, 1., 0, 0/
C
C       TEST FIRST CALL?
C
        NEW = ( NO .NE. N)
        IF ( .NOT. NEW) GO TO 2
C
C       IF FIRST CALL COMPUTE LOG2 (N).
C
        L2N = 0
        NO = 1
    1   L2N = L2N + 1
        NO = NO + NO
        IF (NO .LT. N) GO TO 1
        GAIN = 1./N
        ANG = PI2*GAIN
        RE = COS (ANG)
        IM = SIN (ANG)
C
C       COMPUTE COMPLEX EXPONENTIALS IF NOT FIRST CALL
C
    2   IF (.NOT. NEW .AND. K*KO .GE. 1) GO TO 4
        U(1) = CMPLX (RE, -SIGN(IM, FLOAT(K)))
        DO 3 I = 2,L2N
           U(I) = U(I-1)*U(I-1)
    3   CONTINUE
        K0 = K
C
C       MAIN LOOP
C
    4   SBY2 = N
        DO 7 STAGE = 1,L2N
           V = U(STAGE)
           W = (1., 0.)
           S = SBY2
           SBY2 = S/2
           DO 6 L = 1,SBY2
                DO 5 I = 1,N,S
                   P = I + L- 1
                   Q = P + SBY2
                   T = X(P) + X(Q)
                   X(Q) = ( X(P) - X(Q))*W
                   X(P) =T
    5           CONTINUE
                W = W*V
    6      CONTINUE
    7   CONTINUE
C
C       REORDER THE ELEMENTS BY BIT REVERSAL
C
        DO 9 I = 1,N
           INDEX = I-1
           JNDEX = 0
           DO 8 J = 1,L2N
                JNDEX = JNDEX+JNDEX
                ITEMP = INDEX/2
                IF (ITEMP+ITEMP .NE. INDEX) JNDEX = JNDEX + 1
                INDEX = ITEMP
    8      CONTINUE
           J = JNDEX + 1
           IF (J .LT. I) GO TO 9
           XTEMP = X(J)
           X(J) = X(I)
           X(I) = XTEMP
    9   CONTINUE
C
C       FORWARD TRANSFORM DONE
C
        IF (K .GT. 0) RETURN
C
C       INVERSE TRANSFORM
C
        DO 10 I = 1,N
           X(I) = X(I)*GAIN
   10   CONTINUE
        RETURN
        END