!--------( ALTCHG : assign new Obs.Alt.Inf to GRID data )--------
  implicit none
  integer :: lwkdir, lrtrim
  real,allocatable :: f(:,:), g(:,:)
  character(80) :: wdr, flog, fnam1, fnam2, fnam3, buf
  character(72) :: out;  character(20) :: sdtm;  character(10) :: anul
  character(8) :: area, area2, narea, salt, salt2
  integer :: ldr, i, j, kind
  integer :: nc, ncc, iorg, korg, ispa, ispb
  integer :: nc2, ncc2, iorg2, korg2, ispa2, ispb2
  integer :: ixs, iys, mszx, mszy, mx, my
  integer :: ixs2, iys2, mszx2, mszy2, mx2, my2
  real :: vnul, alt, xs, ys, vnul2, alt2, xs2, ys2, dmy

  call premsg('ALTCHG : assign new Obs.Alt.Inf to GRID data')
  call opnpin()
  ldr = lwkdir(50,wdr) + 1
  flog = wdr;  fnam1 = wdr;  fnam2 = wdr;  fnam3 = wdr
  call gparma('Enter LOG filename ==> ', 81-ldr, flog(ldr:80))
  call gparma('Enter input Source data filename ==> ', 81-ldr, fnam1(ldr:80))
  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.')
    nc = ncc
    if (ncc < 200) then
      nc = ncc; ncc = nc + 800
    else
      ncc = ncc - 200; nc = ncc
    endif
  else                                  !-- v2018
    read(buf,'(a8,4x,i4,4i8)') area, ncc, iorg, korg, ispa, ispb
    nc = ncc
    if ((ncc >= 800) .and. (ncc < 1000)) nc = ncc - 800
  endif
  if ((nc >= 1) .and. (nc <= 62)) then
    iorg = 0;  ispa = 0;  ispb = 0
    korg = (nc-30)*360 - 180
    if (nc > 60) korg = 0
    if (nc == 61) iorg = +5400
    if (nc == 62) iorg = -5400
  endif
  read(1,'(a)') buf
  read(buf,*) ixs, iys, mszx, mszy, mx, my, vnul, alt
  write(salt,'(1x,f7.0)') alt
  if (alt == 0.) salt = '    var.'
  if (alt < 0.) salt = '   undef'
  xs = float(ixs)/1000.
  ys = float(iys)/1000.
  write(out,'(a12,a8,6x,a6,i4,4x,4i8)')   &
    '--- Area :  ', area, 'Coord.', ncc, iorg,korg, ispa,ispb
  call premsg(out)
  write(out,'(a14,2a10,2x,2a8,2a6,a8)')   &
    '      (mesh)  ', 'xs', 'ys', 'msz-x', 'msz-y', 'mx', 'my', 'alt '
  call premsg(out)
  write(out,'(a16,2f10.2,2i8,2i6,a8)')   &
    '      source    ', xs, ys, mszx, mszy, mx, my, salt
  call premsg(out)
  write(anul,'(f9.2)') vnul
  if ((anul(9:9) /= '0') .or. (anul(1:1) /= ' '))   &
    call abendm('unable to handle vnul value')

  allocate(f(mx,my))

  read(1,*) ((f(i,j),i=1,mx),j=1,my)
  close(1)
  if (alt == 0.) then
    call premsg('*** WARN ***  existing  Varible Alt data  will be lost')
  else if (alt > 0.) then
    call premsg('*** WARN ***  Going to replace const.Alt with new value')
  else
    call premsg('Alt data  will be assigned new (from Undef)')
  endif

  call premsg('')
  call premsg('Select  new Alt data source:')
  call premsg('    0) Const. value, 1) Simple grid file,')
  call gparmi('     or 2) 2nd set data of any GRID file ==> ', kind)
  if ((kind < 0) .or. (kind > 2)) call abendm('illegal selection')
  if (kind == 0) then
    call gparmf('Enter new const.Alt (m) value  ==> ', alt2)
    if (alt2 < 1.) call abendm('invalid value')
  else

    allocate(g(mx,my))

    call gparma('Enter Alt data filename ==> ', 81-ldr, fnam2(ldr:80))
    open(2,file=fnam2,status='old')
    read(2,'(a)') buf
    do while (buf(1:1) == '#')
      read(2,'(a)') buf
    enddo
    if (buf(13:16) == '    ') then          !-- v2005
      read(buf,'(a8,i4,4x,4i8)') area2, ncc2, iorg2,korg2, ispa2,ispb2
      if ((ncc2<0) .or. (ncc2>=400)) call abendm('invalid coord.no.')
      nc2 = ncc2
      if (ncc2 < 200) then
        nc2 = ncc2; ncc2 = nc2 + 800
      else
        ncc2 = ncc2 - 200; nc2 = ncc2
      endif
    else                                    !-- v2018
      read(buf,'(a8,4x,i4,4i8)') area2, ncc2, iorg2,korg2, ispa2,ispb2
      nc2 = ncc2
      if ((ncc2 >= 800) .and. (ncc2 < 1000)) nc2 = ncc2 - 800
    endif
    read(2,'(a)') buf
    read(buf,*) ixs2, iys2, mszx2, mszy2, mx2, my2, vnul2, alt2
    if (kind == 2) then
      if (alt2 /= 0.) call abendm('out of spec HeaderInf Alt [1st set]')
      read(2,*) ((dmy,i=1,mx2),j=1,my2)
      read(2,'(a)') buf
      do while (buf(1:1) == '#')
        read(2,'(a)') buf
      enddo
      if (buf(13:16) == '    ') then        !-- v2005
        read(buf,'(a8,i4,4x,4i8)') area2, ncc2, iorg2,korg2, ispa2,ispb2
        if ((ncc2<0) .or. (ncc2>=400)) call abendm('invalid coord.no.')
        nc2 = ncc2
        if (ncc2 < 200) then
          nc2 = ncc2; ncc2 = nc2 + 800
        else
          ncc2 = ncc2 - 200; nc2 = ncc2
        endif
      else                                  !-- v2018
        read(buf,'(a8,4x,i4,4i8)') area2, ncc2, iorg2,korg2, ispa2,ispb2
        nc2 = ncc2
        if ((ncc2 >= 800) .and. (ncc2 < 1000)) nc2 = ncc2 - 800
      endif
      read(2,'(a)') buf
      read(buf,*) ixs2, iys2, mszx2, mszy2, mx2, my2, vnul2, alt2
    endif
    if ((nc2 >= 1) .and. (nc2 <= 62)) then
      iorg2 = 0;  ispa2 = 0;  ispb2 = 0
      korg2 = (nc2-30)*360 - 180
      if (nc2 > 60) korg2 = 0
      if (nc2 == 61) iorg2 = +5400
      if (nc2 == 62) iorg2 = -5400
    endif
    write(salt2,'(1x,f7.0)') alt2
    if (alt2 == 0.) salt2 = '    var.'
    if (alt2 < 0.) salt2 = '   undef'
    xs2 = float(ixs2)/1000.
    ys2 = float(iys2)/1000.
    write(out,'(a12,a8,6x,a6,i4,4x,4i8)')   &
      '--- Area :  ', area2, 'Coord.', ncc2, iorg2,korg2, ispa2,ispb2
    call premsg(out)
    write(out,'(a14,2a10,2x,2a8,2a6,a8)')   &
      '      (mesh)  ', 'xs', 'ys', 'msz-x', 'msz-y', 'mx', 'my', 'alt '
    call premsg(out)
    write(out,'(a16,2f10.2,2i8,2i6,a8)')   &
      '      source    ', xs2, ys2, mszx2, mszy2, mx2, my2, salt2
    call premsg(out)
    if ((ncc2 /= ncc) .or. (iorg2 /= iorg) .or. (korg2 /= korg) .or.   &
        (ispa2 /= ispa) .or. (ispb2 /= ispb) .or.   &
        (ixs2 /= ixs) .or. (iys2 /= iys) .or. (mszx2 /= mszx) .or.   &
        (mszy2 /= mszy) .or. (mx2 /= mx) .or. (my2 /= my))   &
      call abendm('Header1 inconsistent')
    write(anul,'(f10.3)') vnul2
    if ((anul(9:10) /= '00') .or. (anul(1:1) /= ' '))   &
      call abendm('unable to handle vnul2 value')
    read(2,*) ((g(i,j),i=1,mx),j=1,my)
    close(2)
  endif

  call gparma('Enter Name-label for output data  ==> ', 8, narea)
  call gparma('Enter filename of new output data ==> ', 81-ldr, fnam3(ldr:80))
  call clspin()
  write(6,'(a)') '----------------------------------------'
  write(6,'(a)') 'ALTCHG : assign new Obs.Alt.Inf to GRID data'
  write(6,'(a,a)') ' Source infile   : ', fnam1(1:lrtrim(fnam1))
  write(6,'(a,a)') '    areaname : ', area
  if (kind == 0) then
    write(6,'(a,a,4x,a,f8.0)') ' Const.Alt.value : ', alt2
  else
    write(6,'(a,a)') ' AltData infile  : ', fnam2(1:lrtrim(fnam2))
    write(6,'(a,a,a,i2)') '    areaname : ', area2, '  /  Nseq=', kind
  endif
  write(6,'(a,a)') ' Output new file : ', fnam3(1:lrtrim(fnam3))
  write(6,'(a12,a8,6x,a6,i4,4x,4i8)')   &
    'Areaname :  ', narea, 'Coord.', ncc, iorg, korg, ispa, ispb
  write(6,'(4x,a)') &
    '  (mesh)          xs        ys     msz-x   msz-y    mx    my'
  write(6,'(4x,a12,2f10.2,2i8,2i6)')   &
    'grid out=in ', xs, ys, mszx, mszy, mx, my

  open(3,file=fnam3,status='new')
  write(3,'(a,a)') '# Source:  ', fnam1(1:lrtrim(fnam1))
  write(3,'(a2,a8,4x,i4,4i8)') '# ', area, ncc, iorg,korg, ispa,ispb
  if (kind == 0) then
    write(3,'(a,f8.0)') '# prog.ALTCHG applied    Const.Alt.value: ', alt2
    write(3,'(a8,4x,i4,4i8)') narea, ncc, iorg,korg, ispa,ispb
    write(3,'(2i12,4i6,1x,f7.1,1x,f7.0)') ixs,iys, mszx,mszy, mx,my, vnul,alt2
    do j=1,my
      write(3,'((f7.1,9(1x,f7.1)))') (f(i,j),i=1,mx)
    enddo
  else
    write(3,'(a,i2,a1)') '# prog.ALTCHG applied    [Nseq =', kind, ']'
    write(3,'(a,a)') '# AltData: ', fnam2(1:lrtrim(fnam2))
    write(3,'(a2,a8,4x,i4,4i8)') '# ', area, ncc, iorg,korg, ispa,ispb
    write(3,'(a8,4x,i4,4i8)') narea, ncc, iorg,korg, ispa,ispb
    write(3,'(2i12,4i6,1x,f7.1,1x,f7.0)') ixs,iys, mszx,mszy, mx,my, vnul, 0.
    do j=1,my
      write(3,'((f7.1,9(1x,f7.1)))') (f(i,j),i=1,mx)
    enddo
    write(3,'(a8,4x,i4,4i8)') narea, ncc, iorg,korg, ispa,ispb
    write(3,'(2i12,4i6,1x,f7.1,1x,f7.0)') ixs,iys, mszx,mszy, mx,my, vnul2,-1.
    do j=1,my
      write(3,'((f7.1,9(1x,f7.1)))') (g(i,j),i=1,mx)
    enddo
  endif
  close(3)

  if (flog(ldr:ldr) /= ' ') then
    open(99,file=flog,access='append')
    write(99,'(//a)') 'ALTCHG : assign new Obs.Alt.Inf to GRID data'
    write(99,'(a,a)') ' Source infile   : ', fnam1(1:lrtrim(fnam1))
    write(99,'(a,a)') '    areaname : ', area
    if (kind == 0) then
      write(99,'(a,f8.0)') ' prog.ALTCHG applied    Const.Alt.value: ', alt2
    else
      write(99,'(a,i2,a1)') ' prog.ALTCHG applied    [Nseq =', kind, ']'
      write(99,'(a,a)') ' AltData infile  : ', fnam2(1:lrtrim(fnam2))
      write(99,'(a,a,a,i2)') '    areaname : ', area2, '  /  Nseq=', kind
    endif
    write(99,'(a,a)') ' Output new file : ', fnam3(1:lrtrim(fnam3))
    write(99,'(a12,a8,6x,a6,i4,4x,4i8)')   &
      'Areaname :  ', narea, 'Coord.', ncc, iorg, korg, ispa, ispb
    write(99,'(4x,a)')   &
      '  (mesh)          xs        ys     msz-x   msz-y    mx    my'
    write(99,'(4x,a12,2f10.2,2i8,2i6)')   &
      'grid out=in ', xs, ys, mszx, mszy, mx, my
    call strdtm(sdtm)
    write(99,'(a,a,a)') '=============== ', sdtm, '==============='
    close(99)
  endif
  stop
  end