!--------( DESPIKE : suppress magnetic spike in line data )--------
  implicit none
  integer :: lwkdir, lrtrim
  real,parameter :: ph = 3.
  real(8) :: dido(10), dkdo(10), wtm(10), tmag(10)
  real :: falt(10), tres(10), fx(10), fy(10), fz(10), utc(10)
  integer :: ifd(10), iymd(10), km(10), kf(10)
  character(80) :: wdr, flog, fnam, fout
  character(150) :: buf; character(20) :: sdtm
  integer :: ldr, i, j, n, ky, IER
  real :: fid
  real(8) :: ar, cr, d, dm

  call premsg('DESPIKE : suppress magnetic spike in line data')
  call opnpin()
  ldr = lwkdir(50,wdr) + 1
  flog = wdr;  fnam = wdr;  fout = wdr
  call gparma('Enter LOG filename ==> ', 81-ldr, flog(ldr:80))
  call gparma('Enter Input data filename   ==> ', 81-ldr, fnam(ldr:80))
  open(1,file=fnam,status='old')
  call gparma('Enter Output data filename  ==> ', 81-ldr, fout(ldr:80))
  call clspin()
  open(2,file=fout,status='new')
  write(6,'(a)') '----------------------------------------'
  write(6,'(a)') 'DESPIKE : suppress magnetic spike in line data'
  write(6,'(a,a)') ' Input filename   : ', fnam(1:lrtrim(fnam))
  write(6,'(a,a)') ' Output filename  : ', fout(1:lrtrim(fout))

  ky = 0
  do while (ky == 0)
    i = 0
    do while (i < 9)
      i = i + 1
      read(1,'(a)',iostat=IER) buf
      if (IER < 0) then
        ky = 1; exit
      endif
      if ((buf(1:1)=='&') .or. (buf(1:1)=='%')) then
        do j=1,i-1
          write(2,'(i8,1x,i8,1x,f9.2,1x,i2,1x,f11.7,1x,f12.7,$)')   &
            ifd(j),iymd(j),wtm(j),km(j),dido(j),dkdo(j)
          write(2,'(1x,f7.2,2(1x,f8.2),3(1x,f7.3),1x,f9.2)')   &
           falt(j),tmag(j),tres(j),fx(j),fy(j),fz(j),utc(j)
        enddo
        write(2,'(a)') buf(1:lrtrim(buf))
        i = 0; cycle
      endif

      read(buf,*) fid,iymd(i),wtm(i),km(i),dido(i),dkdo(i),   &
              falt(i),tmag(i),tres(i),fx(i),fy(i),fz(i),utc(i)
      ifd(i) = nint(fid);  kf(i) = 0
    enddo
    if (ky == 1) exit

    do 
      j = 0;  dm = ph
      call estim(tmag, kf, ar, cr)
      i = 0
      do i=1,9
        if (kf(i) /= 0) cycle
        d = ar*float(i-5) + cr - tmag(i)
        if ((d <= dm) .and. (d >= -dm)) cycle
        j = i;  dm = abs(d)
      enddo
      if (j == 0) exit
      kf(j) = 1
    enddo

    do i=5,1,-1
      if (kf(i) == 0) cycle
      d = ar*float(i-5) + cr - tmag(i)
      tres(i) = real(tres(i) + d);  tmag(i) = tmag(i) + d;  kf(i) = 0
      call estim(tmag, kf, ar, cr)
    enddo
    do i=1,5
      write(2,'(i8,1x,i8,1x,f9.2,1x,i2,1x,f11.7,1x,f12.7,$)')   &
        ifd(i),iymd(i),wtm(i),km(i),dido(i),dkdo(i)
      write(2,'(1x,f7.2,2(1x,f8.2),3(1x,f7.3),1x,f9.2)')   &
        falt(i),tmag(i),tres(i),fx(i),fy(i),fz(i),utc(i)
    enddo

    do
      read(1,'(a)',iostat=IER) buf
      if (IER < 0) then
        ky = 2; exit
      endif
      if ((buf(1:1)=='&') .or. (buf(1:1)=='%')) exit
      read(buf,*) ifd(10),iymd(10),wtm(10),km(10),dido(10),dkdo(10),   &
        falt(10),tmag(10),tres(10),fx(10),fy(10),fz(10),utc(10)
      kf(10) = 0
      do i=1,9
        ifd(i) = ifd(i+1);  iymd(i) = iymd(i+1);  wtm(i) = wtm(i+1)
        km(i) = km(i+1);  dido(i) = dido(i+1);  dkdo(i) = dkdo(i+1)
        falt(i) = falt(i+1);  tmag(i) = tmag(i+1);  tres(i) = tres(i+1)
        fx(i) = fx(i+1);  fy(i) = fy(i+1);  fz(i) = fz(i+1)
        utc(i) = utc(i+1);  kf(i) = kf(i+1)
      enddo
      call estim(tmag, kf, ar, cr)
      d = cr - tmag(5)
      if ((kf(5) /= 0) .or. (d > ph) .or. (d < -ph)) then
        tres(5) = real(tres(5) + d);  tmag(5) = tmag(5) + d;  kf(5) = 0
      endif
      d = ar*4. + cr - tmag(9)
      if ((d > ph) .or. (d < -ph)) kf(9) = 1
      write(2,'(i8,1x,i8,1x,f9.2,1x,i2,1x,f11.7,1x,f12.7,$)')   &
        ifd(5),iymd(5),wtm(5),km(5),dido(5),dkdo(5)
      write(2,'(1x,f7.2,2(1x,f8.2),3(1x,f7.3),1x,f9.2)')   &
        falt(5),tmag(5),tres(5),fx(5),fy(5),fz(5),utc(5)
    enddo
    if (ky == 2) exit

    do i=6,9
      if (kf(i) /= 0) then
        d = ar*float(i-5) + cr - tmag(i)
        tres(i) = real(tres(i) + d);  tmag(i) = tmag(i) + d;  kf(i) = 0
        call estim(tmag, kf, ar, cr)
      endif
      write(2,'(i8,1x,i8,1x,f9.2,1x,i2,1x,f11.7,1x,f12.7,$)')   &
        ifd(i),iymd(i),wtm(i),km(i),dido(i),dkdo(i)
      write(2,'(1x,f7.2,2(1x,f8.2),3(1x,f7.3),1x,f9.2)')   &
        falt(i),tmag(i),tres(i),fx(i),fy(i),fz(i),utc(i)
    enddo
    write(2,'(a)') buf(1:lrtrim(buf))
  enddo

  if (ky == 1) then
    n = i-1
    do i=1,n
      write(2,'(i8,1x,i8,1x,f9.2,1x,i2,1x,f11.7,1x,f12.7,$)')   &
        ifd(i),iymd(i),wtm(i),km(i),dido(i),dkdo(i)
      write(2,'(1x,f7.2,2(1x,f8.2),3(1x,f7.3),1x,f9.2)')   &
        falt(i),tmag(i),tres(i),fx(i),fy(i),fz(i),utc(i)
    enddo
  else
    do i=6,9
      if (kf(i) /= 0) then
        d = ar*float(i-5) + cr - tmag(i)
        tres(i) = real(tres(i) + d);  tmag(i) = tmag(i) + d;  kf(i) = 0
        call estim(tmag, kf, ar, cr)
      endif
      write(2,'(i8,1x,i8,1x,f9.2,1x,i2,1x,f11.7,1x,f12.7,$)')   &
        ifd(i),iymd(i),wtm(i),km(i),dido(i),dkdo(i)
      write(2,'(1x,f7.2,2(1x,f8.2),3(1x,f7.3),1x,f9.2)')   &
        falt(i),tmag(i),tres(i),fx(i),fy(i),fz(i),utc(i)
    enddo
  endif
  close(2)

  if (flog(ldr:ldr) /= ' ') then
    open(99,file=flog,access='append')
    write(99,'(//a)') 'DESPIKE : suppress magnetic spike in line data'
    write(99,'(a,a)') ' Input filename   : ', fnam(1:lrtrim(fnam))
    write(99,'(a,a)') ' Output filename  : ', fout(1:lrtrim(fout))
    call strdtm(sdtm)
    write(99,'(a,a,a)') '=============== ', sdtm, '==============='
    close(99)
  endif
  stop
  end
!---
  subroutine estim(tmag, kf, ar, cr)
  implicit none
  real(8),intent(in) :: tmag(9)
  integer,intent(in) :: kf(9)
  real(8),intent(out) :: ar, cr
  real :: sxx, sxy, sx, sy, x, y, denom
  integer :: n, i
  sxx = 0.;  sxy = 0.;  sx = 0.;  sy = 0.;  n = 0
  do i=1,9
    if (kf(i) /= 0) cycle
    x = float(i-5);  y = real(tmag(i) - tmag(5))
    sxx = sxx + x*x;  sxy = sxy + x*y
    sx = sx + x;  sy = sy + y;  n = n + 1
  enddo
  denom = sxx*float(n) - sx*sx
  ar = (sxy*float(n) - sx*sy) / denom
  cr = (sxx*sy - sxy*sx) / denom + tmag(5)
  return
  end subroutine