subroutine cho_inq(arg, gdev, pps, cols, rows)

	implicit none

	character arg*(*), pps*(*), gdev*(*)
	integer cols, rows

	character str*80, old1*80, old2*80, line*80
	character typ*2, host*80, system*16
	integer c,r,i,l,cnt,inter,n,j

	cols=0
	rows=0
	call pgqndt(n)
	str=' '
	pps=' '
	gdev=' '
	r=0
	c=0

	call sys_remote_host(host, typ)
	if (typ .eq. 'XW') then
	  gdev='XWINDOW'
	  goto 30
	endif
	if (typ .eq. 'LO') goto 90 ! local without XWINDOW
	call sys_check_system(system)
	if (system .ne. 'TRU64') goto 90 ! on linux no other devices supported

	! remote login without XWINDOW
	if (arg .ne. ' ') then
	  cnt=5
	  call str_trim(str, arg, l)
	  goto 21
	endif
	cnt=0
20	cnt=cnt+1
	if (cnt .eq. 2) then
	  old1=str
	elseif (cnt .eq. 3) then
	  if (str .eq. old1) goto 80
          print *,'Please do not touch the keyboard!',char(7)
          call sys_wait(1.0)
	  old2=str
        elseif (cnt .eq. 4) then
	  if (str .eq. old1 .or. str .eq. old2) goto 80
          print *,'Do not touch the keyboard, please !!!',char(7)
          call sys_wait(2.0)
	elseif (cnt .gt. 4) then
	  goto 90
	endif
	r=0
	c=0
	
	print '(X,A,$)', '   '
	call sys_rd_tmo(char(5),str,l)
c	print *,str(1:max(1,l))

21	if (l .gt. 2 .and. str(1:2) .eq. '_ ') then
	  i=index(str(1:l),',')
	  if (i .ne. 0) then
	    if (i .le. 3 .or. i .ge. l) goto 20
	    r=-1
	    read(str(i+1:l), *, err=22,end=22) r,c
22	    if (r .lt. 0) goto 20
	    l=i-1
	  endif
	  i=index(str(1:l),';')
	  if (i .eq. 0) then
	    gdev=str(3:l)
	  else
	    if (i .gt. 3) gdev=str(3:i-1)
	    if (i .lt. l) pps=str(i+1:l)
	  endif

	  goto 60

	endif


30	cnt=10 ! exit anyway

	call cho_load(host, gdev, pps)

60	if (gdev .ne. ' ') then
	  do i=1,n
	    call pgqdt(i, str, l, line, j, inter)
	    if (l .gt. 0 .and. inter .eq. 1) then
	      if (str(2:) .eq. gdev) goto 70
	    endif
	  enddo
	  if (gdev .eq. 'VT240') then
	    gdev='VT125'
	  else if (gdev .eq. 'VMAC') then ! if VMAC not installed, do not ask again
	    gdev=' '
	    cnt=10
	  else
	    gdev=' '
	  endif
70	  continue
	endif

80	if (r .gt. 3 .and. r .lt. 100) then
	  rows=r
	endif
	if (c .ge. 40 .and. c .le. 255) then
	  cols=c
	endif
	if (gdev .eq. ' ' .and. cnt .le. 4) goto 20 ! try again
90	call cho_vpp_cups(pps)
	end


	subroutine cho_load(host, gdev, pps)
!
! load graphic device GDEV and print destination PPS from the line
! starting with HOME from preferences file
!
	character*(*) host, gdev, pps

	integer lun, l, j, ld, iostat
	character line*80, home*80

	call sys_get_lun(lun)
	call sys_home(home)
	call str_trim(home, home, l)
	call str_trim(host, host, ld)

	call sys_open(lun, home(1:l)//'terinq.pref', 'r', iostat)
	if (iostat .ne. 0) goto 29

25	read(lun, '(a)',end=27,err=27) line
	l=index(line,':')
	if (l .gt. 1) then
c	  print *,'host: "',host(1:ld),'"'
	  if (index(line(1:l-1), host(1:ld)) .ne. 0) then
	    j=index(line(l+1:),';')
	    if (gdev .eq. ' ') then
	      if (j .eq. 0) then
	        gdev=line(l+1:)
	      elseif (j .gt. 1) then
	        gdev=line(l+1:l+j-1)
	      endif
	    endif
	    if (pps .eq. ' ') then
	      if (j .gt. 0 .and. l+j .le. len(line)) then
	        pps=line(l+j+1:)
	      endif
	    endif
	    close(lun)
	    goto 29
	  endif
	endif
	goto 25
27	close(lun)
29	call sys_free_lun(lun)	  
	end


	subroutine cho_save(host, devdest)

	character host*(*), devdest*(*)  ! no trailing blanks, please
	integer lun, lun1

	character home*128, line*128
	logical done
	integer l,ll,lh,iostat

	call sys_get_lun(lun)
	call sys_home(home)
	call str_trim(home, home, lh)

	done=.false.

	call sys_get_lun(lun1)
	call sys_open(lun1, home(1:lh)//'terinq.pref1', 'w', iostat)
	if (iostat .ne. 0) goto 91

	call sys_open(lun, home(1:lh)//'terinq.pref', 'r', iostat)
	if (iostat .ne. 0) goto 12

10	read(lun, '(a)',end=11,err=11) line
	l=index(line,':')
	if (l .gt. 1) then
	  if (index(line(1:l), host) .ne. 0) then
	    done=.true.
	    write(lun1, '(2a)') line(1:l),devdest
	    goto 10
	  endif
	endif
	call cho_vpp_cups(line)
	call str_trim(line, line, ll)
	write(lun1, '(a)') line(1:ll)
	goto 10
11	close(lun)
12	if (.not. done) then
	  write(lun1, '(3a)') host,':',devdest
	endif
27	close(lun1)
91	call sys_free_lun(lun)
	call sys_free_lun(lun1)
	call sys_rename_file(home(1:lh)//'terinq.pref1'
	1,home(1:lh)//'terinq.pref')
	end


	subroutine cho_choose(ask) !!

	character ask*1 ! ' ': info only
	                ! '?': ask for all parameters
	                ! 'G' ask for graphic device, if not defined
	                ! 'P' ask for printer device, if not defined

	character popt*1, pan*8, file*48, pcmd*48, gdev*8, pdev*8
	character dest*32, host*64
	save popt, pan, file, pcmd, gdev, pdev, dest, host

	character ans*80, typ*8, desc*64, gdesc*64, pdesc*64
	character pdev2*8, dev0*8, cfg*64
	integer i, j, l, m, n, inter, la, h, v, ipan, lc
	logical savepref, init/.true./, initg/.true./
	integer n_names, i_gdev, i_popt, i_pan, i_file
	integer i_pcmd, i_pdev, i_dest
	parameter (n_names=7, i_gdev=1, i_popt=2, i_pan=3, i_file=4
	1 , i_pcmd=5, i_pdev=6, i_dest=7)
	character names(n_names)*16
	data names(i_gdev)/'CHOOSER_GDEV'/
	data names(i_popt)/'CHOOSER_POPT'/
	data names(i_pan )/'CHOOSER_PAN' /
	data names(i_file)/'CHOOSER_FILE'/
	data names(i_pcmd)/'CHOOSER_PCMD'/
	data names(i_pdev)/'CHOOSER_PDEV'/
	data names(i_dest)/'CHOOSER_DEST'/

	character opt(4)*50/
	1 'F    write a file (one file per page)'
	1,'A    write a file (all pages on one file)'
	1,'L    send plots to printer (all together on exit)'
	1,'I    send plots immediately to printer'/

	savepref=.false.
	call pgqndt(n)

	if (init) then
	  init=.false.

	  call sys_loadenv

	  call sys_getenv(names(i_gdev), gdev)
	  call sys_getenv(names(i_popt), popt)
	  call sys_getenv(names(i_pan ), pan)
	  call sys_getenv(names(i_file), file)
	  call sys_getenv(names(i_pcmd), pcmd)
	  call sys_getenv(names(i_pdev), pdev)
	  call sys_getenv(names(i_dest), dest)

	  if (pan .eq. ' ') then
	    pan='1'
	    call sys_setenv(names(i_pan ), pan)
	  endif
	  if (file .eq. ' ') then
	    file='pgplot.ps'
	    call sys_setenv(names(i_file), file)
	  endif
	  if (popt .eq. ' ') then
	    popt='L'
	    call sys_setenv(names(i_popt), popt)
	  endif
	  if (pdev .eq. ' ') then
	    pdev='PS'
	    call sys_setenv(names(i_pdev), pdev)
	  endif
	endif
	if (ask .eq. 'G') then
	  if (initg) then
	    initg=.false.
	    if (gdev .eq. ' ') then
	      call cho_inq(' ', gdev, dest, i, j)
	      call sys_setenv(names(i_gdev), gdev)
	      call sys_setenv(names(i_dest), dest)
	    endif
	    call sys_setenv('PGPLOT_DEV', '/'//gdev)
	  endif
	endif

	ans=' '
	if (ask .eq. 'G') then
	  if (gdev .ne. ' ') goto 99
	  ans='G'
	elseif (ask .eq. 'P') then
	  if (popt .eq. 'A' .or. popt .eq. 'F') then
	    if (file .ne. ' ') goto 99
	    ans='F'
	  else
	    i=index(pcmd, '*')
	    if (i .ne. 0) then
	      if (dest .ne. ' ') goto 99
	      call str_trim(pcmd, pcmd, l)
	      print *,'Print command: ',pcmd(1:l)
	      ans='D'
	    else
	      if (pcmd .ne. ' ') goto 99
	      ans='C'
	    endif
	  endif
	endif

20	continue

	gdesc='unknown'
	pdesc='unknown'
	read(pan, *, err=21,end=21) ipan
21	call cho_calc_pan(ipan, h, v)
	if (v .gt. h) then
	  if (pdev(1:1) .ne. 'V' .and. pdev(2:2) .ne. 'V') then
	    pdev2=pdev(1:1)//'V'//pdev(2:)
	    pdev='V'//pdev
	  endif
	else
	  if (pdev(1:1) .eq. 'V') then
	    pdev=pdev(2:)
	  elseif (pdev(2:2) .eq. 'V') then
	    pdev=pdev(1:1)//pdev(3:)
	  endif
	  pdev2=' '
	endif	  
	do i=1,n
	  call pgqdt(i, typ, l, desc, m, inter)
	  if (l .gt. 0) then
	    if (inter .eq. 1) then
	      if (gdev .eq. typ(2:) .or.
	1         gdev .eq. 'VT240' .and. typ(2:) .eq. 'VT125') then
	        gdesc=typ(2:l)//' '//desc
	      endif
	    elseif (pdev .eq. typ(2:)) then
	      pdesc=typ(2:l)//' '//desc
	    elseif (pdev2 .eq. typ(2:)) then
	      pdev=pdev2
	      pdesc=typ(2:l)//' '//desc
	    endif
	  endif
	enddo
	call sys_setenv(names(i_pdev), pdev)

	if (ask .eq. ' ') then ! info only
	  call str_trim(gdesc, gdesc, l)
	  print *,'Display device type: ',gdesc(1:l)
	  call str_trim(pdesc, pdesc, l)
	  print *,'Printer device type: ',pdesc(1:l)
	  if (popt .eq. 'F' .or. popt .eq. 'A') then
	    call str_trim(file, file, l)
	    if (popt .eq. 'F') then
	      print *,'one file per page, filename: ', file(1:l),'_n'
	    else
	      print *,'all pages on one page. filename: ', file(1:l)
	    endif
	  else
	    call str_trim(pcmd, pcmd, l)
	    call str_trim(dest, dest, i)
	    if (pcmd .eq. ' ') then
	      print *,'print command undefined'
	    elseif (dest .eq. ' ' .and. index(pcmd,'*') .ne. 0) then
	      print *,'print destination undefined'
	    elseif (dest .ne. ' ' .and. index(pcmd,'*') .eq. 0) then
	      print *,'print destination ignored'
	1,' (print command does not contain *)'
	    elseif (popt .eq. 'L') then
	      print *,'print later on ',dest(1:i)
	1           ,' with command: ', pcmd(1:l)
	    else
	      print *,'print immediately on ',dest(1:i)
	1           ,' with command: ', pcmd(1:l)
	    endif
	  endif
	  if (pan .ne. '1') then
	    print *,pan,' graphs per page'
	  else
	    print *,'one graph per page'
	  endif
	  print *
	  goto 99
	endif

	if (ans .eq. ' ') then
	  print *,    'Option  Description                  Actual State'
	  print '(X,79(''-''))'
	  call str_trim(gdesc, gdesc, l)
	  l=min(l,42)
	  print *,    '   G    change display device type   '//gdesc(1:l)
	  call str_trim(pdesc, pdesc, l)
	  l=min(l,42)
	  print *,    '   P    change printer device type   '//pdesc(1:l)

	  print *
          do j=1,4
	    if (popt .eq. opt(j)(1:1)) then
              print *,'>> ',opt(j)
	    else
	      print *,'   ',opt(j)
	    endif
	  enddo
c	  if (popt .eq. 'F') then
c	    print *,'   ',opt(2),'    every page will be written to'
c	    print *,'   ',opt(3),'    a separate file'
c	    print *,'   ',opt(4)
c	  elseif (popt .eq. 'A') then
c	    print *,'   ',opt(1),'    all pages will be written to one'
c	    print *,'   ',opt(3),'    large file'
c	    print *,'   ',opt(4)
c	  elseif (popt .eq. 'L') then
c	    print *,'   ',opt(1),'    all pages will be sent on exit to'
c	    print *,'   ',opt(2),'    the selected printer'
c	    print *,'   ',opt(4),'    (select F or A to write on a file)'
c	  elseif (popt .eq. 'I') then
c	    print *,'   ',opt(1),'    every page will be sent immediately'
c	    print *,'   ',opt(2),'    to the selected printer'
c	    print *,'   ',opt(3),'    (select F or A to write on a file)'
c	  endif
!	  i=index('FALI',popt)

!	  do j=1,4
!	    if (j .ne. i) then
!	      print *,'   ',opt(j)
!	    endif
!	  enddo
	  print *

	  if (popt .eq. 'F' .or. popt .eq. 'A') then
	    call str_trim(file, file, l)
	    print *,  '   N    change print file name       ',file(1:l)
	  else
	    call str_trim(pcmd, pcmd, l)
	    print *,  '   C    change print command         ',pcmd(1:l)
	    call str_trim(dest, dest, l)
	    print *,  '   D    change print destination     ',dest(1:l)
	  endif
	  print '(x,2a)'
	1       ,    ' 1...99 number of graphs per page    ',pan
	  print *
	  print '(x,a,$)'
	1         ,'Enter option or <RET> to continue: '
	  ans=' '
	  read(*,'(a)',end=40,err=40) ans
	endif

40	if (ans .eq. ' ') then
	  if (popt .eq. 'L' .or. popt .eq. 'I') then
	    if (pcmd .ne. ' ') then
	      if (index(pcmd,'*') .eq. 0) then
	        if (dest .eq. ' ') goto 99
	        print *
	        print *,'Print destination ignored'
	1,' (print command does not contain *)'
	        goto 99
	      else
	        if (dest .ne. ' ') goto 99
	        print *
	        print *,'Print destination undefined'
	      endif
	    else
	      print *
	      print *,'Print command undefined'
	    endif
	    call str_trim(file, file, l)
	    if (popt .eq. 'L') then
	      popt='A'
	      print *, 'Save all pages on: ',file(1:l)
	    else
	      popt='F'
	      print *, 'Save pages on: ',file(1:l),'_n'
	    endif
	    print *
	    call sys_setenv('CHOOSER_POPT', popt)
	  endif
	  goto 99
	endif
	call str_upcase(ans(1:1), ans(1:1))
	if (ans(1:1) .eq. 'G') then
41	  if (ans(2:) .eq. ' ') then
	    print *
	    do i=1,n
	      call pgqdt(i, typ, l, desc, m, inter)
	      if (l .gt. 0 .and. inter .eq. 1) then
	        m=max(1,m)
	        print *,typ(2:),' ',desc(1:m)
	      endif
	    enddo
	  endif
	  print *
	  call cho_get_arg('Display device type: ', ans)
	  call str_upcase(ans, ans)
	  call str_trim(ans, ans, la)
	  if (la .gt. 7) la=7
	  if (ans .ne. ' ' .and. gdev(1:la) .ne. ans(1:la)) then
	    dev0=' '
	    do i=1,n
	      call pgqdt(i, typ, l, desc, m, inter)
	      if (l .gt. 0 .and. inter .eq. 1) then
	        if (typ(2:) .eq. ans) then
		  dev0=ans
	          goto 411
	        endif
	        if (typ(2:la+1) .eq. ans(1:la)) then
	          if (dev0 .ne. ' ') then
	            print *,'Ambiguous device type: ',ans(1:la)
	            ans=' '
	            goto 41
	          endif
	          dev0=typ(2:)
	        endif
	      endif
	    enddo
	    if (dev0 .eq. ' ') then
	      print *,'Unknown display device: ',ans(1:la)
	      ans=' '
	      goto 41
	    endif
411	    gdev=dev0
	    call sys_setenv(names(i_gdev), gdev)
	    call sys_setenv('PGPLOT_DEV', '/'//gdev)
	    savepref=.true.
	  endif
	elseif (ans(1:1) .eq. 'P') then
42	  if (ans(2:) .eq. ' ') then
	    print *
	    do i=1,n
	      call pgqdt(i, typ, l, desc, m, inter)
	      if (l .gt. 0 .and. inter .eq. 0) then
	        m=max(1,m)
	        print *,typ(2:),' ',desc(1:m)
	      endif
	    enddo
	  endif
	  print *
	  call cho_get_arg('Printer device type: ', ans)
	  call str_upcase(ans, ans)
	  call str_trim(ans, ans, la)
	  if (ans .ne. ' ' .and. pdev(1:la) .ne. ans(1:la)) then
	    dev0=' '
	    do i=1,n
	      call pgqdt(i, typ, l, desc, m, inter)
	      if (l .gt. 0 .and. inter .eq. 0) then
	        if (typ(2:) .eq. ans) then
	          dev0=ans
	          goto 421
	        endif
	        if (typ(2:la+1) .eq. ans(1:la)) then
	          if (dev0 .ne. ' ') then
	            print *,'Ambiguous device type: ',ans(1:la)
	            ans=' '
	            goto 42
	          endif
	          dev0=typ(2:)
	        endif
	      endif
	    enddo
	    if (dev0 .eq. ' ') then
	      print *,'Unknown printer device: ',ans(1:la)
	      ans=' '
	      goto 42
	    endif
421	    pdev=dev0
	    if (index(pdev, 'PS') .eq. 0) then ! non postscript variants
	      popt='F'
	      call sys_setenv(names(i_popt), popt)
	      file='?'
	      call sys_setenv(names(i_file), file)
	    endif
	    call sys_setenv(names(i_pdev), pdev)
	  endif
	elseif (ans(1:1) .eq. 'N') then
	  call cho_get_arg('File Name: ', ans)
	  if (ans .ne. ' ' .and. ans .ne. file) then
	    file=ans
	    call sys_setenv(names(i_file), file)
	  endif
	elseif (ans(1:1) .eq. 'C') then
	  print *
	  print *
	1 ,'Note: the print command should contain * (asterisk)'
	1 ,'as a placeholder for the print destination'
	  print *
	  call cho_get_arg('Print Command: ', ans)
	  if (ans .ne. ' ' .and. ans .ne. pcmd) then
	    pcmd=ans
	    call sys_setenv(names(i_pcmd), pcmd)
	  endif
	elseif (ans(1:1) .eq. 'D') then
	  call cho_get_arg('Print destination: ', ans)
	  if (ans .ne. ' ' .and. ans .ne. dest) then
	    call str_trim(ans, ans, i)
	    if (i .lt. 3) then
	      print *,ans(1:i),' is an illegal destination'
	    else
	      dest=ans
	      call sys_setenv(names(i_dest), dest)
	      savepref=.true.
	    endif
	  endif
	else
	  i=index('FALI',ans(1:1))
	  if (i .ne. 0) then
	    if (popt .ne. ans(1:1)) then
	      popt=ans(1:1)
	      call sys_setenv(names(i_popt), popt)
	    endif
	  else
	    read(ans, '(bn,i8)', err=50,end=50) i
	    if (i .gt. 0 .and. i .le. 99) then
	      call cho_calc_pan(i, h, v)
	      i=h*v
	      if (i .ne. ipan) then
	        if (i .le. 9) then
	          write(pan, '(i1)') i
	        else
	          write(pan, '(i2)') i
	        endif
	        call sys_setenv(names(i_pan ), pan)
	      endif
	    else
	      print *,'unknown option'
	    endif
	  endif
	endif
50	ans=' '
	goto 20

99	call sys_saveenv
	if (savepref) then
	  call sys_getenv('CHOOSER_TERINQ', ans)
	  if (ans(1:1) .ne. '1') goto 999 ! save only if terinq used
	  if (gdev .ne. 'XWINDOW' .and. gdev .ne. 'XSERVE') then
	    call str_trim(cfg,gdev,lc)
	  else
	    lc=0
	  endif
	  print *
	  if (lc .gt. 0) then
	    print *,'Graphic device: ',cfg(1:lc)
	  endif
	  call str_append(cfg,lc,';')
	  call str_trim(pdev, pdev, l)
	  if (index('VCPS VPS ',pdev(1:l+1)) .ne. 0) then
	    if (dest .ne. ' ') then
	      print *,'Printer destination: ',dest
	      call str_append(cfg,lc,dest)
	      call str_trim(cfg,cfg(1:lc),lc)
	    endif
	  endif
	  if (lc .gt. 1) then
	    call sys_remote_host(host, typ)
	    call str_trim(host,host,l)
	    print '(x,3a,$)','Save this for next session from '
	1                  ,host(1:l),'? [N/y]: '
	    read(*,'(a)',end=999,err=999) ans
	    call str_upcase(ans(1:1), ans(1:1))
	    if (ans(1:1) .eq. 'Y') then
	      call str_trim(host, host, l)
	      print *,'saved'
	      call cho_save(host(1:l),cfg(1:lc))
	    endif
	  endif
	endif
999	end


	subroutine cho_get_arg(prompt, ans)

	character prompt*(*), ans*(*)

	integer i
	if (ans(2:) .ne. ' ') then
	  i=2
10	  if (ans(i:i) .eq. ' ') then
	    i=i+1
	    goto 10
	  endif
	  ans=ans(i:)
	else
	  print '(x,a,$)',prompt
	  ans=' '
	  read(*,'(a)',end=9,err=9) ans
	endif
9	end


	subroutine cho_calc_pan(p, h, v)

! calculate h, v from number of panels p, in order that h*v~=p or h*v*2~=p

	integer p
	integer h,v

	if (p .le. 1) goto 9

	v=nint(sqrt(p*1.0))
	h=nint(sqrt(p*0.5))
	if (abs(v*v-p) .lt. abs(h*h*2-p)) then
	  h=v
	else
	  v=h*2
	endif
	return

9	h=1
	v=1
	end



	subroutine cho_vpp_cups(str)

	character str*(*)
	character up*80
	integer i

	call str_upcase(up, str)
	i=index(up,'PSW')
	if (i .gt. 0) then
	  if (up(i:i+4) .eq. 'PSW18') str(i:)='WHGA_138_1'
	  if (up(i:i+4) .eq. 'PSW21') str(i:)='SINQ_LHO_1'
	  if (up(i:i+4) .eq. 'PSW22') str(i:)='WHGA_243_1'
	  if (up(i:i+4) .eq. 'PSW24') str(i:)='SINQ_LHW_1'
	  if (up(i:i+4) .eq. 'PSW25') str(i:)='SINQ_THO_1'
	end if
	end