!--------( SELDB2 : gen. new grid-data from AMDB2 grid file )--------
  implicit none
  integer :: lwkdir, lrtrim
  character(*),parameter :: AMDB2DIR = '/pub/AMDB2/DATA/'
  real,allocatable :: f(:,:), h(:,:), r(:,:), t(:,:)
  real :: v(401,601), w(401,601)
  character(80) :: wdr, flog, fnam1, fnam2, buf
  character(20) :: sdtm;  character(8) :: area, narea
  integer :: ldr, i, j, m, n, li, lk, ix, iy, i1, i2
  integer :: ncc, iorg, korg, ispa, ispb, ml, mh, nl, nh
  integer :: ncn, nccn, iorgn, korgn, ispan, ispbn
  integer :: ixs, iys, mszx, mszy, mx, my
  integer :: ixl, iyl, mszxn, mszyn, mxn, myn, ixh, iyh
  integer :: lil, lih, lis, lia, lib, lkl, lkh, lks, lka, lkb
  real :: f1, f2, f3, f4, h1, h2, h3, h4, f12, f34, h12, h34
  real :: xl, yl, xh, yh, fi1, fi2, fi3, fi4, fk1, fk2, fk3, fk4
  real :: vnul, alt, fi, fk, dx, dy
  logical cond

  call premsg('SELDB2 : gen. new grid-data from AMDB2 grid file')
  call opnpin()
  ldr = lwkdir(50,wdr) + 1
  flog = wdr;  fnam2 = wdr
  call gparma('Enter LOG filename ==> ', 81-ldr, flog(ldr:80))
  call premsg('')
  call gparma('Enter Name-label for new grid ==> ', 8, narea)
  call gparmi('Select Coordinate Number (+800 for Old-TOKYO) ==> ', nccn)
  ncn = nccn
  if (nccn >= 800) ncn = nccn - 800
  ispan = 0;  ispbn = 0
  if ((ncn >= 1) .and. (ncn <= 62)) then
    iorgn = 0
    korgn = (ncn-30)*360 - 180
    if (ncn > 60) korgn = 0
    if (ncn == 61) iorgn = +5400
    if (ncn == 62) iorgn = -5400
  else if (ncn == 65) then
    iorgn = 0
    call gparmi('  Central Longitude ?  (Deg.) : ', i1)
    korgn = i1*60
  else
    if (ncn == 72) call abendm('nc=72 not supported')
    call gparmi2('  Origin Latitude ?   (Deg. Min.) : ', i1,i2)
    iorgn = i1*60 + i2
    call gparmi2('  Origin Longitude ?  (Deg. Min.) : ', i1,i2)
    korgn = i1*60 + i2
  endif
  call cvinit(nccn, float(iorgn),float(korgn), float(ispan),float(ispbn))
  call premsg('Specify gridding parameters')
  call premsg('  Southwest corner Coord. in km ?')
  call gparmf('    Northing : ', xl)
  ixl = nint(xl*1000.)
  call gparmf('    Easting  : ', yl)
  iyl = nint(yl*1000.)
  call premsg('  Mesh size and numbers to N ?')
  call gparmi('    Unit Mesh size in m :  ', mszxn)
  if (mszxn <= 0) call abendm('invalid value')
  call gparmi('    Number of Mesh to N :  ', mxn)
  ixh = ixl + (mxn-1)*mszxn
  xh = float(ixh) / 1000.
  call premsg('  Mesh size and numbers to E ?')
  call gparmi('    Unit Mesh size in m :  ', mszyn)
  if (mszyn <= 0) call abendm('invalid value')
  call gparmi('    Number of Mesh to E :  ', myn)
  iyh = iyl + (myn-1)*mszyn
  yh = float(iyh) / 1000.

  allocate(r(mxn,myn));  allocate(t(mxn,myn))

  call gparma('Enter new grid output filename ==> ', 81-ldr, fnam2(ldr:80))
  call clspin()
  open(2,file=fnam2,status='new')
  write(6,'(a)') '----------------------------------------'
  write(6,'(a)') 'SELDB2 : gen. new grid-data from AMDB2 grid file'
  write(6,'(a,a)') ' Output new file : ', fnam2(1:lrtrim(fnam2))
  write(6,'(a12,a8,6x,a6,i4,4x,4i8)')   &
    'Areaname :  ', narea, 'Coord.', nccn, iorgn,korgn, ispan,ispbn
  write(6,'(4x,a)')   &
    '  (mesh)          xs        ys     msz-x   msz-y    mx    my    alt '
  write(6,'(4x,a12,2f10.2,2i8,2i6,a8)')   &
    'gen.new grid', xl, yl, mszxn, mszyn, mxn, myn, '    var.'
  call cvenik(yl, xl, fi1, fk1)
  call cvenik(yh, xh, fi2, fk2)
  call cvenik(yh, xl, fi3, fk3)
  call cvenik(yl, xh, fi4, fk4)
  if (fi3 < fi1) fi1 = fi3
  if (fi4 > fi2) fi2 = fi4
  if (fk4 < fk1) fk1 = fk4
  if (fk3 > fk2) fk2 = fk3
  lil = ifix(fi1*10.)
  lih = ifix(fi2*10.) + 1
  lkl = ifix(fk1*10. - 60000.)
  lkh = ifix(fk2*10. - 60000.) + 1

  allocate(f(lih-lil+1,lkh-lkl+1));  f(:,:) = 9999.9
  allocate(h(lih-lil+1,lkh-lkl+1));  h(:,:) = 9999.9

  ml = lil / 400
  mh = (lih+399) / 400
  nl = lkl / 600
  nh = (lkh+599) / 600
  do m=ml,mh
    lis = m * 400
    lia = max(lis,lil)
    lib = min(lis+400,lih)
    do n=nl,nh
      lks = n * 600
      lka = max(lks,lkl)
      lkb = min(lks+600,lkh)
      write(fnam1,'(a,2i2.2,a)') AMDB2DIR, m, n, '.mgc'
      inquire(file=fnam1,exist=cond)
      if (cond) then
        open(1,file=fnam1,status='old')
        read(1,'(a)') buf
        do while (buf(1:1) == '#')
          read(1,'(a)') buf
        enddo
        if (buf(13:16) == '    ') then      !-- v2005
          read(buf,'(a8,i4,4x,4i8)') area, ncc, iorg, korg, ispa, ispb
          if ((ncc<0) .or. (ncc>=400)) call abendm('invalid coord.no.')
          if (ncc < 200) then
            ncc = ncc + 800
          else
            ncc = ncc - 200
          endif
        else                                !-- v2018
          read(buf,'(a8,4x,i4,4i8)') area, ncc, iorg, korg, ispa, ispb
        endif
        if (ncc /= 199) call abendm('illegal AMDB2 file Header1')
        read(1,*) ixs, iys, mszx, mszy, mx, my, vnul, alt
        if ((mszx /= 100) .or. (mszy /= 100) .or. (mx /= 401) .or.   &
            (my /= 601) .or. (vnul /= 9999.9) .or. (alt /= 0.))   &
          call abendm('illegal AMDB2 file Header2')
        read(1,*) ((v(i,j),i=1,401),j=1,601)
        read(1,'(a)') buf
        do while (buf(1:1) == '#')
          read(1,'(a)') buf
        enddo
        if (buf(13:16) == '    ') then      !-- v2005
          read(buf,'(a8,i4,4x,4i8)') area, ncc, iorg, korg, ispa, ispb
          if ((ncc<0) .or. (ncc>=400)) call abendm('invalid coord.no.')
          if (ncc < 200) then
            ncc = ncc + 800
          else
            ncc = ncc - 200
          endif
        else                                !-- v2018
          read(buf,'(a8,4x,i4,4i8)') area, ncc, iorg, korg, ispa, ispb
        endif
        if (ncc /= 199) call abendm('illegal AMDB2 file Header3')
        read(1,*) ixs, iys, mszx, mszy, mx, my, vnul, alt
        if ((mszx /= 100) .or. (mszy /= 100) .or. (mx /= 401) .or.   &
            (my /= 601) .or. (vnul /= 9999.9) .or. (alt /= -1.))   &
          call abendm('illegal AMDB2 file Header4')
        read(1,*) ((w(i,j),i=1,401),j=1,601)
        close(1)
        do li=lia,lib;  do lk=lka,lkb
          f(li-lil+1,lk-lkl+1) = v(li-lis+1,lk-lks+1)
          h(li-lil+1,lk-lkl+1) = w(li-lis+1,lk-lks+1)
        enddo;  enddo
      endif
    enddo
  enddo

  write(2,'(a)')  '# prog.SELDB2 output'
  write(2,'(a8,4x,i4,4i8)') narea, nccn, iorgn,korgn, ispan,ispbn
  write(2,'(2i12,4i6,1x,f7.1,1x,f7.0)') ixl,iyl, mszxn,mszyn, mxn,myn, vnul, 0.
  do j=1,myn
    iy = iyl + (j-1)*mszyn
    do i=1,mxn
      ix = ixl + (i-1)*mszxn
      call cvenik(float(iy)/1000., float(ix)/1000., fi, fk)
      lk = ifix(fk*10. - 60000.)
      dy = fk*10. - 60000. - float(lk)
      li = ifix(fi*10.)
      dx = fi*10. - float(li)
      if ((li < lil) .or. (li >= lih) .or. (lk < lkl) .or. (lk >= lkh)) then
        r(i,j) = vnul;  t(i,j) = vnul
      else
        f1 = f(li-lil+1,lk-lkl+1)
        f2 = f(li-lil+1,lk-lkl+2)
        f3 = f(li-lil+2,lk-lkl+1)
        f4 = f(li-lil+2,lk-lkl+2)
        if ((f1==vnul) .or. (f2==vnul) .or. (f3==vnul) .or. (f4==vnul)) then
          r(i,j) = vnul;  t(i,j) = vnul
        else
          f12 = f1*(1.-dy) + f2*dy
          f34 = f3*(1.-dy) + f4*dy
          r(i,j) = f12*(1.-dx) + f34*dx
          h1 = h(li-lil+1,lk-lkl+1)
          h2 = h(li-lil+1,lk-lkl+2)
          h3 = h(li-lil+2,lk-lkl+1)
          h4 = h(li-lil+2,lk-lkl+2)
          if ((h1==vnul) .or. (h2==vnul) .or. (h3==vnul) .or. (h4==vnul)) then
            r(i,j) = vnul;  t(i,j) = vnul
          else
            h12 = h1*(1.-dy) + h2*dy
            h34 = h3*(1.-dy) + h4*dy
            t(i,j) = h12*(1.-dx) + h34*dx
          endif
        endif
      endif
    enddo
  enddo
  do j=1,myn
    write(2,'((f7.1,9(1x,f7.1)))') (r(i,j),i=1,mxn)
  enddo
  write(2,'(a8,4x,i4,4i8)') narea, nccn, iorgn,korgn, ispan,ispbn
  write(2,'(2i12,4i6,1x,f7.1,1x,f7.0)')   &
    ixl,iyl, mszxn,mszyn, mxn,myn, vnul, -1.
  do j=1,myn
    write(2,'((f7.1,9(1x,f7.1)))') (t(i,j),i=1,mxn)
  enddo
  close(2)

  if (flog(ldr:ldr) /= ' ') then
    open(99,file=flog,access='append')
    write(99,'(//a,$)') 'SELDB2 :'
    write(99,'(a)')   ' gen. new grid-data from AMDB grid file'
    write(99,'(a,a)') ' Output new file : ', fnam2(1:lrtrim(fnam2))
    write(99,'(a12,a8,6x,a6,i4,4x,4i8)')   &
      'Areaname :  ', narea, 'Coord.', nccn, iorgn,korgn, ispan,ispbn
    write(99,'(4x,a)')   &
      '  (mesh)          xs        ys     msz-x   msz-y    mx    my    alt '
    write(99,'(4x,a12,2f10.2,2i8,2i6,a8)')   &
      'gen.new grid', xl, yl, mszxn, mszyn, mxn, myn, '    var.'
    call strdtm(sdtm)
    write(99,'(a,a,a)') '=============== ', sdtm, '==============='
    close(99)
  endif
  stop
  end