!**************************************************************
!   FILTADASC : Filter ADC data on Common ASCII format file   *
!**************************************************************
  implicit none
  integer :: lwkdir, lrtrim
  real :: fid(101), fx(101), fy(101), fz(101)
  real :: ralt(101), balt(101), ad6(101), ad7(101), ad8(101)
  real :: sfx, sfy, sfz, sra, sba, sa6, sa7, sa8
  real(8) :: tmag(101), t200(101)
  character(80) :: wdr, flog, fnam, fout
  character(160) :: line;  character(50) :: s(101), sm
  character(20) :: sdtm; character(11) :: hmst(101)
  integer :: ldr, i, j, k, m, nh, nf, IER

  call premsg('FILTADASC : Filter ADC data on Common ASCII format file')
  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 ComASCII filename ==> ', 81-ldr, fnam(ldr:80))
  open(10,file=fnam,status='old')
  call gparma('Enter Output filename ==> ', 81-ldr, fout(ldr:80))
  open(20,file=fout,status='new')
  call premsg('Select Half size (n) of Smoothing window')
  call gparmi('  [N to average (2N+1) data]  N ==> ', nh)
  if ((nh < 1) .or. (nh > 50))   &
    call abendm('parameter not accepted')
  call clspin()
  write(6,'(a)') '----------------------------------------'
  write(6,'(a)') 'FILTADASC : Filter ADC data on Common ASCII format file'
  write(6,'(a,a)') ' Input filename : ', fnam(1:lrtrim(fnam))
  write(6,'(a,a)') ' Output filename : ', fout(1:lrtrim(fout))
  write(6,'(a,i2)') ' Half window size : ', nh
  nf = nh + 1 + nh
  do
    read(10,'(a)') line
    if (line(1:2) == '//') then
      write(20,'(a)') line(1:lrtrim(line))
    else
      exit
    endif
  enddo
  write(20,'(a,i2)') '// FILTADASC applied with NH=', nh
  do
    if (line(1:1) == '/') then
      write(20,'(a)') line(1:lrtrim(line))
    else
      exit
    endif
    read(10,'(a)') line
  enddo
  read(line,'(f7.1,1x,a11,2f10.3,8f8.3,a50)')   &
            fid(1), hmst(1), t200(1), tmag(1), fx(1),fy(1),fz(1),   &
            ralt(1), balt(1), ad6(1),ad7(1),ad8(1), s(1)
  do i=2,nf
    read(10,'(a)') line
    read(line,'(f7.1,1x,a11,2f10.3,8f8.3,a50)')   &
              fid(i), hmst(i), t200(i), tmag(i), fx(i),fy(i),fz(i),   &
              ralt(i), balt(i), ad6(i),ad7(i),ad8(i), s(i)
  enddo

  do i=1,nh
    sfx = 0.;  sfy = 0.;  sfz = 0.;  sra = 0.;  sba = 0.
    sa6 = 0.;  sa7 = 0.;  sa8 = 0.;  m = i*2 - 1
    do k=1,m
      sfx = sfx + fx(k);  sfy = sfy + fy(k);  sfz = sfz + fz(k)
      sra = sra + ralt(k);  sba = sba + balt(k)
      sa6 = sa6 + ad6(k);  sa7 = sa7 + ad7(k);  sa8 = sa8 + ad8(k)
    enddo
    sfx = sfx / m;  sfy = sfy / m;  sfz = sfz / m
    sra = sra / m;  sba = sba / m
    sa6 = sa6 / m;  sa7 = sa7 / m;  sa8 = sa8 / m
    sm = s(i)
    write(20,'(f7.1,1x,a11,2f10.3,8f8.3,a)')   &
          fid(i), hmst(i), t200(i), tmag(i), sfx, sfy, sfz,   &
          sra, sba, sa6, sa7, sa8, sm(1:lrtrim(sm))
  enddo

  do
    sfx = 0.;  sfy = 0.;  sfz = 0.;  sra = 0.;  sba = 0.
    sa6 = 0.;  sa7 = 0.;  sa8 = 0.
    do k=1,nf
      sfx = sfx + fx(k);  sfy = sfy + fy(k);  sfz = sfz + fz(k)
      sra = sra + ralt(k);  sba = sba + balt(k)
      sa6 = sa6 + ad6(k);  sa7 = sa7 + ad7(k);  sa8 = sa8 + ad8(k)
    enddo
    sfx = sfx / nf;  sfy = sfy / nf;  sfz = sfz / nf
    sra = sra / nf;  sba = sba / nf
    sa6 = sa6 / nf;  sa7 = sa7 / nf;  sa8 = sa8 / nf
    sm = s(nh+1); i = nh+1
    write(20,'(f7.1,1x,a11,2f10.3,8f8.3,a)')   &
          fid(i), hmst(i), t200(i), tmag(i), sfx, sfy, sfz,   &
          sra, sba, sa6, sa7, sa8, sm(1:lrtrim(sm))
    read(10,'(a)',iostat=IER) line
    if (IER < 0) exit
    do i=2,nf
      fid(i-1) = fid(i); hmst(i-1) = hmst(i); t200(i-1) = t200(i)
      tmag(i-1) = tmag(i); fx(i-1) = fx(i); fy(i-1) = fy(i)
      fz(i-1) = fz(i); ralt(i-1) = ralt(i); balt(i-1) = balt(i)
      ad6(i-1) = ad6(i); ad7(i-1) = ad7(i); ad8(i-1) = ad8(i)
      s(i-1) = s(i)
    enddo
    read(line,'(f7.1,1x,a11,2f10.3,8f8.3,a50)')   &
            fid(nf), hmst(nf), t200(nf), tmag(nf), fx(nf),fy(nf),fz(nf),   &
            ralt(nf), balt(nf), ad6(nf),ad7(nf),ad8(nf), s(nf)
  enddo

  do i=nh+2,nf
    sfx = 0.;  sfy = 0.;  sfz = 0.;  sra = 0.;  sba = 0.
    sa6 = 0.;  sa7 = 0.;  sa8 = 0.;  j = nf - i;  m = j*2 + 1
    do k=i-j,i+j
      sfx = sfx + fx(k);  sfy = sfy + fy(k);  sfz = sfz + fz(k)
      sra = sra + ralt(k);  sba = sba + balt(k)
      sa6 = sa6 + ad6(k);  sa7 = sa7 + ad7(k);  sa8 = sa8 + ad8(k)
    enddo
    sfx = sfx / m;  sfy = sfy / m;  sfz = sfz / m
    sra = sra / m;  sba = sba / m
    sa6 = sa6 / m;  sa7 = sa7 / m;  sa8 = sa8 / m
    sm = s(i)
    write(20,'(f7.1,1x,a11,2f10.3,8f8.3,a)')   &
          fid(i), hmst(i), t200(i), tmag(i), sfx, sfy, sfz,   &
          sra, sba, sa6, sa7, sa8, sm(1:lrtrim(sm))
  enddo

  close(10);  close(20)

  if (flog(ldr:ldr) /= ' ') then
    open(99,file=flog,access='append')
    write(99,'(//a)') 'FILTADASC : Filter ADC data on Common ASCII format file'
    write(99,'(a,a)') ' Input filename : ', fnam(1:lrtrim(fnam))
    write(99,'(a,a)') ' Output filename : ', fout(1:lrtrim(fout))
    write(99,'(a,i2)') ' Half window size : ', nh
    call strdtm(sdtm)
    write(99,'(a,a,a)') '=============== ', sdtm, '==============='
    close(99)
  endif
  stop
  end