!--------( DVCORR : Correction of Diurnal var. for AM data )--------
  implicit none
  integer :: lwkdir, lrtrim
  character(80) :: wdr, flog, fgst, fnam, fout
  character(150) :: buf;  character(20) :: sdtm
  integer :: ldr, iymd, km, ihm, nm, IER
  real :: fid, falt, tres, fx, fy, fz, dvc
  real(8) :: wtm, tm, tmag, dido, dkdo

  call premsg('DVCORR : Diurnal var. correction for AM data')
  call opnpin()
  ldr = lwkdir(50,wdr) + 1
  flog = wdr;  fgst = wdr;  fnam = wdr;  fout = wdr
  call gparma('Enter LOG filename ==> ', 81-ldr, flog(ldr:80))
  call gparma('Enter AM data filename ==> ', 81-ldr, fnam(ldr:80))
  open(1,file=fnam,status='old')
  call gparma('Enter GS data filename ==> ', 81-ldr, fgst(ldr:80))
  open(10,file=fgst,status='old')
  call dvcmag(0, 0.d0, dvc)
  call gparma('Enter Output filename  ==> ', 81-ldr, fout(ldr:80))
  open(2,file=fout,status='new')
  call clspin()
  write(6,'(a)') '----------------------------------------'
  write(6,'(a)') 'DVCORR : Correction of Diurnal variation for AM data'
  write(6,'(a,a)') ' Input filename   : ', fnam(1:lrtrim(fnam))
  write(6,'(a,a)') ' GS data filename : ', fgst(1:lrtrim(fgst))
  write(6,'(a,a)') ' Output filename  : ', fout(1:lrtrim(fout))

  do
    read(1,'(a)',iostat=IER) buf
    if (IER < 0) exit
    if ((buf(1:1)=='&') .or. (buf(1:1)=='%')) then
      write(2,'(a)') buf(1:lrtrim(buf))
      cycle
    endif
    read(buf,*) fid,iymd,wtm,km,dido,dkdo,falt,tmag,tres,fx,fy,fz,tm
    if (mod(km,4) < 2)   &
      call abendm('already Corrected for Diurnal variation')
    ihm = int(wtm/100.);  tm = wtm - dble(ihm*100)
    nm = ihm - ihm/100*40;  tm = tm + float(nm*60);
    call dvcmag(iymd, tm, dvc)
    tmag = tmag - dvc;  tres = tres - dvc
    write(2,'(i8,1x,i8,1x,f9.2,1x,i2,1x,f11.7,1x,f12.7,1x,f7.2,$)')   &
      nint(fid),iymd,wtm,(km-2),dido,dkdo,falt
    write(2,'(2(1x,f8.2), 3(1x,f7.3), 1x,f9.2)')  tmag,tres,fx,fy,fz,tm
  enddo
  close(2);  close(1);  close(10)
  if (flog(ldr:ldr) /= ' ') then
    open(99,file=flog,access='append')
    write(99,'(//a)') 'DVCORR : Correction of Diurnal variation for AM data'
    write(99,'(a,a)') ' Input filename   : ', fnam(1:lrtrim(fnam))
    write(99,'(a,a)') ' GS data filename : ', fgst(1:lrtrim(fgst))
    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 dvcmag(iymd, tm, dvc)
  implicit none
  integer,intent(in) :: iymd
  real(8),intent(in) :: tm
  real,intent(out) :: dvc
  save
  character(40) :: buf; character(17) :: dtm
  integer :: jymd, jymdn, jhms, jh, jm, js, kgs=0, IER
  real :: base, vm, dvc1, dvc2
  real(8) :: tmn, tm1, tm2

  if (iymd == 0) then
    jymd = 0;  base = 0.
    do
      read(10,'(a)',iostat=IER) buf
      if (IER < 0) then
        write(buf,'(a,i9,a,f9.1)') '--- req:   ymd=', iymd, '   hms=', tm
        call premsg(buf);  call abendm('EOF on GSmag data file')
      endif
      if (buf(1:1) == '/') then
        if ((buf(1:5) == '/date') .or. (buf(1:5) == '/Date')) then
          read(buf(7:40),*) jymdn
          if (jymdn < jymd) call abendm('GSmag data out of order')
          jymd = jymdn;  kgs = 0;  cycle
        else if ((buf(1:5) == '/base') .or. (buf(1:5) == '/Base')) then
          read(buf(7:40),*) base
          do while (base > 200000.)
            base = base / 10.
          enddo
          cycle
        endif
      else
        read(buf,*) jhms, vm
        jm = jhms / 100;  js = jhms - jm*100
        jh = jm / 100;  jm = jm - jh*100
        tmn = float(jh*3600 + jm*60 + js)
        do while (vm > 200000.)
          vm = vm / 10.
        enddo
        if (kgs == 0) then
          tm2 = tmn;  dvc2 = vm - base;  kgs = 1;  cycle
        else
          tm1 = tm2;  dvc1 = dvc2
          tm2 = tmn;  dvc2 = vm - base;  kgs = 2;  exit
        endif
      endif
    enddo
    dvc = 0.; return
  endif
  do while (iymd > jymd)
    do
      read(10,'(a)',iostat=IER) buf
      if (IER < 0) then
        write(buf,'(a,i9,a,f9.1)') '--- req:   ymd=', iymd, '   hms=', tm
        call premsg(buf);  call abendm('EOF on GSmag data file')
      endif
      if (buf(1:1) == '/') then
        if ((buf(1:5) == '/date') .or. (buf(1:5) == '/Date')) then
          read(buf(7:40),*) jymdn
          if (jymdn < jymd) call abendm('GSmag data out of order')
          jymd = jymdn;  kgs = 0;  cycle
        else if ((buf(1:5) == '/base') .or. (buf(1:5) == '/Base')) then
          read(buf(7:40),*) base
          do while (base > 200000.)
            base = base / 10.
          enddo
          cycle
        endif
      else
        read(buf,*) jhms, vm
        jm = jhms / 100;  js = jhms - jm*100
        jh = jm / 100;  jm = jm - jh*100
        tmn = float(jh*3600 + jm*60 + js)
        do while (vm > 200000.)
          vm = vm / 10.
        enddo
        if (kgs == 0) then
          tm2 = tmn;  dvc2 = vm - base;  kgs = 1;  cycle
        else
          tm1 = tm2;  dvc1 = dvc2
          tm2 = tmn;  dvc2 = vm - base;  kgs = 2;  exit
        endif
      endif
    enddo
  enddo
  do while (tm > tm2)
    do
      if ((iymd < jymd) .or. (tm < tm1)) then
        jhms = idnint(tm);  jm = jhms / 60;  js = jhms - jm*60;
        jh = jm / 60;  jm = jm - jh*60
        write(dtm,'(i8,a1,i2.2,a1,i2.2,a1,i2.2)') iymd, '-', jh,':',jm,':',js
        call abendm('GSmag data not available for ' // dtm)
      endif
      read(10,'(a)',iostat=IER) buf
      if (IER < 0) then
        write(buf,'(a,i9,a,f9.1)') '--- req:   ymd=', iymd, '   hms=', tm
        call premsg(buf);  call abendm('EOF on GSmag data file')
      endif
      if (buf(1:1) == '/') then
        if ((buf(1:5) == '/date') .or. (buf(1:5) == '/Date')) then
          read(buf(7:40),*) jymdn
          if (jymdn < jymd) call abendm('GSmag data out of order')
          jymd = jymdn;  kgs = 0;  cycle
        else if ((buf(1:5) == '/base') .or. (buf(1:5) == '/Base')) then
          read(buf(7:40),*) base
          do while (base > 200000.)
            base = base / 10.
          enddo
          cycle
        endif
      else
        read(buf,*) jhms, vm
        jm = jhms / 100;  js = jhms - jm*100
        jh = jm / 100;  jm = jm - jh*100
        tmn = float(jh*3600 + jm*60 + js)
        do while (vm > 200000.)
          vm = vm / 10.
        enddo
        if (kgs == 0) then
          tm2 = tmn;  dvc2 = vm - base;  kgs = 1;  cycle
        else
          tm1 = tm2;  dvc1 = dvc2
          tm2 = tmn;  dvc2 = vm - base;  kgs = 2;  exit
        endif
      endif
    enddo
  enddo
  dvc = real((dvc1*(tm2-tm) + dvc2*(tm-tm1)) / (tm2-tm1))
  return
  end subroutine