!--------( PFRAME : plot framework of coordinates )--------
  implicit none
  integer :: lwkdir, lrtrim
  external cviken
  character(80) :: wdr, flog, fnam;  character(20) :: sdtm
  character(11) :: scd1, scd2, scd3, scd4, scd
  character(8) :: area, aval;  character(3) :: spl;  character(1) :: yn

  integer :: ldr, m, nc, ncc, iorg, korg, ispa, ispb
  integer :: ideg, imin, lats, latn, lonw, lone, iunit
  integer :: ixs, ixt, iys, iyt, kpl, inc, kshl, ix, iy, i, k, i1, i2
  real :: x, x1, x2, x3, x4, y, y1, y2, y3, y4
  real :: deg, fun, xs, xt, ys, yt, r, fscl, high, wide

  call premsg('PFRAME : plot framework of coordinates')
  call opnpin()
  ldr = lwkdir(50,wdr) + 1
  flog = wdr;  fnam = wdr
  call gparma('Enter LOG filename ==> ', 81-ldr, flog(ldr:80))
  call gparma('Enter Output PS filename  ==> ', 81-ldr, fnam(ldr:80))
  if (fnam(ldr:ldr) == ' ') fnam(1:1) = char(0)
  if (fnam(80:80) /= ' ') call abendm('too long filename')
  call gparma('Areaname (8 chrs max) : ', 8, area)
  call gparmi('Select Coordinate Number (+800 for Old-TOKYO) ==> ', ncc)
  nc = ncc;  m = 1
  if ((ncc >= 800) .and. (ncc < 1000)) then
    nc = ncc - 800;  m = 0
  endif
  ispa = 0;  ispb = 0
  if ((nc >= 1) .and. (nc <= 62)) then
    iorg = 0;  korg = (nc-30)*360 - 180
    if (nc > 60) korg = 0
    if (nc == 61) iorg = +5400
    if (nc == 62) iorg = -5400
  else if (nc == 65) then
    iorg = 0
    call gparmi2('  Central Longitude ?  (Deg. Min.) : ', i1,i2)
    korg = i1*60 + i2
  else
    if (nc == 72) call abendm('nc=72 not implemented')
    call gparmi2('  Origin Latitude ?   (Deg. Min.) : ', i1,i2)
    iorg = i1*60 + i2
    call gparmi2('  Origin Longitude ?  (Deg. Min.) : ', i1,i2)
    korg = i1*60 + i2
  endif
  call gparmf2('  South bound Lat. ?  (Deg., Min.) ==> ', deg, fun)
  lats = nint(deg*60. + fun)
  if ((lats < -5400) .or. (lats >= 5400)) call abendm('invalid value')
  ideg = lats / 60
  imin = lats - ideg*60
  write(scd1,'(i4,1h:,i3.2,3h'' N)') ideg, imin
  call gparmf2('  North bound Lat. ?  (Deg., Min.) ==> ', deg, fun)
  latn = nint(deg*60. + fun)
  if ((latn <= lats) .or. (latn > 5400)) call abendm('invalid value')
  ideg = latn / 60
  imin = latn - ideg*60
  write(scd2,'(i4,1h:,i3.2,3h'' N)') ideg, imin
  call gparmf2('  West bound Long. ?  (Deg., Min.) ==> ', deg, fun)
  lonw = nint(deg*60. + fun)
  if ((lonw < -10800) .or. (lonw >= 21600)) call abendm('invalid value')
  ideg = lonw / 60
  imin = lonw - ideg*60
  write(scd3,'(i4,1h:,i3.2,3h'' E)') ideg, imin
  call gparmf2('  East bound Long. ?  (Deg., Min.) ==> ', deg, fun)
  lone = nint(deg*60. + fun)
  if ((lone <= lonw) .or. (lone > 21600)) call abendm('invalid value')
  ideg = lone / 60
  imin = lone - ideg*60
  write(scd4,'(i4,1h:,i3.2,3h'' E)') ideg, imin
  call cvinit(ncc,float(iorg),float(korg),float(ispa),float(ispb))
  call cviken(float(lats), float(lonw), y1, x1)
  call cviken(float(lats), float(lone), y2, x2)
  call cviken(float(latn), float(lone), y3, x3)
  call cviken(float(latn), float(lonw), y4, x4)
  xs = amin1(x1, x2, x3, x4)
  xt = amax1(x1, x2, x3, x4)
  ys = amin1(y1, y2, y3, y4)
  yt = amax1(y1, y2, y3, y4)
  r = amin1(xt-xs, yt-ys)
  if (r >= 100.) then
    if (r >= 500.) then
      if (r >= 1000.) then
        iunit = 500
      else
        iunit = 200
      endif
    else
      if (r >= 250.) then
        iunit = 100
      else
        iunit = 50
      endif
    endif
  else
    if (r >= 25.) then
      if (r >= 50.) then
        iunit = 20
      else
        iunit = 10
      endif
    else
      if (r >= 10.) then
        iunit = 5
      else
        if (r >= 5.) then
          iunit = 2
        else
          iunit = 1
        endif
      endif
    endif
  endif
  ixs = ifix(xs/float(iunit))
  if (xs < 0.) ixs = ixs-1
  xs = float(ixs*iunit)
  ixt = ifix(xt/float(iunit))
  if (xs > 0.) ixt = ixt+1
  xt = float(ixt*iunit)
  iys = ifix(ys/float(iunit))
  if (ys < 0.) iys = iys-1
  ys = float(iys*iunit)
  iyt = ifix(yt/float(iunit))
  if (yt > 0.) iyt = iyt+1
  yt = float(iyt*iunit)
  if ((xt-xs) >= (yt-ys)) then
    kpl = 1
    fscl = amax1((yt-ys)/15., (xt-xs)/25.)
  else
    kpl = 2
    fscl = amax1((yt-ys)/25., (xt-xs)/15.)
  endif
  high = (xt-xs)/fscl
  wide = (yt-ys)/fscl
  if (kpl == 1) spl = 'A4P'
  if (kpl == 2) spl = 'A4L'
  call psopn(fnam, spl)
  inc = nint(fscl*100000.)/25000
  if (inc == 0) inc = 1
  if ((inc > 2) .and. (inc < 5)) inc = 2
  if ((inc > 5) .and. (inc < 10)) inc = 5
  if ((inc > 10) .and. (inc < 20)) inc = 10
  if ((inc > 20) .and. (inc < 60)) inc = 20
  if ((inc > 60) .and. (inc < 120)) inc = 60
  if ((inc > 120) .and. (inc < 300)) inc = 120
  if ((inc > 300) .and. (inc < 600)) inc = 300
  if (inc > 600) inc = 600
  kshl = 2
  call prompt(' Draw  Rivers  ?      ')
  call gparma('  "y" for Yes, othewise No ==> ', 1, yn)
  if (yn == 'y') kshl = 12
  call prompt('       Pref.Boundary ?')
  call gparma('  "y" for Yes, othewise No ==> ', 1, yn)
  if (yn == 'y') then
    kshl = kshl + 200
    if (kshl == 202) kshl = 102
  endif
  call clspin()
  write(6,'(a)') '----------------------------------------'
  write(6,'(a)') 'PFRAME : plot framework of coordinates'
  write(6,'(a,a)') ' Output PS filename  : ', fnam(1:lrtrim(fnam))
  write(6,'(a12,a8,6x,a6,i4,4x,4i8)')   &
    'Areaname :  ', area, 'Coord.', ncc, iorg,korg, ispa,ispb
  write(6,'(15x,4a)') 'Lat. range :   ', scd1, ' - ', scd2
  write(6,'(15x,4a)') 'Lon. range :   ', scd3, ' - ', scd4
  write(6,'(15x,a,f6.0,a,f6.0)') 'SW corner :      x =', xs, '   y =', ys
  write(6,'(15x,a,f6.0,a,f6.0)') 'NE corner :      x =', xt, '   y =', yt
  write(6,'(6x,a,f9.0,3x,a3,f8.1,a1,f8.1,a1)')   &
    'scale  1 /', fscl*100000., spl, high, 'H', wide, 'W'
  write(6,'(a,$)') '      with   Coast'
  if (mod(kshl,100)/10 /= 0) write(6,'(a,$)') '+River'
  if (kshl/100 /= 0) write(6,'(a,$)') '+PrefB'
  write(6,'(a)') '  LatLonLines'

  call plots(3., 2.)
  call lstyle('T', 0.4, 0., 0, -999)
  call penatr(0, 255, 2, 0.01)
  do ix=ixs,ixt
    x = float((ix-ixs)*iunit) / fscl
    call plot(-0.15, x, 3)
    call plot(wide, x, 2)
    write(aval,'(i8)') ix*iunit
    call ptext(aval, 8, -0.2, x-0.1, 1)
  enddo
  do iy=iys,iyt
    y = float((iy-iys)*iunit) / fscl
    call plot(y, -0.15, 3)
    call plot(y, high, 2)
    write(aval,'(i8)') iy*iunit
    call ptext(aval, 8, y, -0.4, 2)
  enddo
  call newpen(1)
  do i=lats,latn
    if ((i /= lats) .and. (i /= latn) .and. (i /= (i/inc*inc))) cycle
    call cviken(float(i), float(lonw), y, x)
    call plot((y-ys)/fscl, (x-xs)/fscl, 3)
    do k=lonw+1,lone
      call cviken(float(i), float(k), y, x)
      call plot((y-ys)/fscl, (x-xs)/fscl, 2)
    enddo
    ideg = i / 60;  imin = i - ideg*60
    write(scd,'(i3,1h:,i3.2,3h'' N)') ideg, imin
    call ptext(scd, 10, (y-ys)/fscl+0.1, (x-xs)/fscl-0.1, 0)
  enddo
  call lstyle('T', 0.4, 90., 0, -999)
  do k=lonw,lone
    if ((k /= lonw) .and. (k /= lone) .and. (k /= (k/inc*inc))) cycle
    call cviken(float(lats), float(k), y, x)
    call plot((y-ys)/fscl, (x-xs)/fscl, 3)
    do i=lats+1,latn
      call cviken(float(i), float(k), y, x)
      call plot((y-ys)/fscl, (x-xs)/fscl, 2)
    enddo
    ideg = k / 60;  imin = k - ideg*60
    write(scd,'(i4,1h:,i3.2,3h'' E)') ideg, imin
    call ptext(scd, 11, (y-ys)/fscl+0.1, (x-xs)/fscl+0.1, 0)
  enddo
  call scisor(0., 0., wide, high)
  if (kshl /= 0) then
    call rshore(m, 20, 50, 120, 155)
    call pshore(-ys/fscl, -xs/fscl, kshl, fscl, cviken)
  endif
  call scisor(0., 0., 0., 0.)
  call lstyle('T', 0.4, 0., 0, -999)
  call ptext(area, 8, -1., -1.5, 0)
  write(aval,'(4hnc =,i4)') ncc
  call ptext(aval, 8, 1., -1.5, 0)
  call plote()
  call pscls()

  if (flog(ldr:ldr) /= ' ') then
    open(99,file=flog,access='append')
    write(99,'(//a,$)') 'PFRAME :'
    write(99,'(a)')   ' plot framework of coordinates'
    write(99,'(a,a)') ' Output PS filename  : ', fnam(1:lrtrim(fnam))
    write(99,'(a12,a8,6x,a6,i4,4x,4i8)')   &
      'Areaname :  ', area, 'Coord.', ncc, iorg,korg,ispa,ispb
    write(99,'(15x,4a)') 'Lat. range :   ', scd1, ' - ', scd2
    write(99,'(15x,4a)') 'Lon. range :   ', scd3, ' - ', scd4
    write(99,'(15x,a,f6.0,a,f6.0)') 'SW corner :      x =', xs, '   y =', ys
    write(99,'(15x,a,f6.0,a,f6.0)') 'NE corner :      x =', xt, '   y =', yt
    write(99,'(6x,a,f9.0,3x,a3,f8.1,a1,f8.1,a1)')   &
      'scale  1 /', fscl*100000., spl, high, 'H', wide, 'W'
    write(99,'(a,$)') '      with   Coast'
    if ((mod(kshl,100)/10) /= 0) write(99,'(a,$)') '+River'
    if ((kshl/100) /= 0) write(99,'(a,$)') '+PrefB'
    write(99,'(a)') '  LatLonLines'
    call strdtm(sdtm)
    write(99,'(a,a,a)') '=============== ', sdtm, '==============='
    close(99)
  endif
  stop
  end