c      program xyzspecs

	character  ifile*40,ifmtv*1
       character*8 buff,passwrd
       character*16 fmtx,fmty
       integer ifmtx(4),ifmty(4)
       dimension xmin(3),xmax(3)
       dimension dxp(2),dyp(2),xp(4),yp(4),idim(1)
       equivalence(ifmtx,fmtx),(ifmty,fmty)
       data passwrd/'sB8yr0hF'/,sizex/.15/,sizey/.15/
       data xmin/3*1.0e38/,xmax/3*-1.0e38/
       call getarg(1,buff,length)
       if(buff.ne.passwrd) then
        print *,'program can only be run from program GEOCON'
        stop
       endif

       ierr = 0
	iswt = 10
       ic = 0

5      print 10
10	format(' enter input random data filename :'\)
	read(*,'(a)') ifile
       call opnsta(iswt,ifile,ifmtv,ierr,*5)
       if(ierr.ne.0) go to 9999 

20     if(ifmtv.eq.' ') then
	   read( iswt, end=225,err=250,iostat=icheck ) x, y, z
       else
	   read( iswt, *, end=225,err=250,iostat=icheck ) x, y, z
       endif
	ic = ic + 1
	if ( x .lt. xmin(1) ) xmin(1) = x
	if ( x .gt. xmax(1) ) xmax(1) = x
	if ( y .lt. xmin(2) ) xmin(2) = y
	if ( y .gt. xmax(2) ) xmax(2) = y
	if ( z .lt. xmin(3) ) xmin(3) = z
	if ( z .gt. xmax(3) ) xmax(3) = z
       go to 20

225   rang=xmax(1)-xmin(1)
      print 231, xmin(1),xmax(1),rang
231   format(/' # x min= ',1pg15.6,' x max= ',g15.6,' range=',g15.6)
      rang=xmax(2)-xmin(2)
      print 232, xmin(2),xmax(2),rang
232   format(' # y min= ',1pg15.6,' y max= ',g15.6,' range=',g15.6)
      rang = xmax(3) - xmin(3)
      print 230, xmin(3), xmax(3), rang
230   format(' # z min= ', 1pg15.6, ' z max= ', g15.6,
     1                  ' range=',g15.6,/)

240   print *, ic, ' records in the file'
       print *,' '
       pause 'press ENTER to plot the data; ENTER again after the plot'
c*****SET UP PLOTTER
        call pltset(9,xp(4),yp(4),isl)
        dxp(1) = xmin(1)
        dxp(2) = xmax(1)
        dyp(1) = xmin(2)
        dyp(2) = xmax(2)
        ncharx = -1
        nchary = -1
        call setax(dxp,adelx,20,ncharx,fmtx)
        call setax(dyp,adely,20,nchary,fmty)
        xp(3) = (nchary+1) * sizey
        yp(3) = (ncharx+1) * sizex
        xp(1)=xp(4)- xp(3) -.2
        yp(1)=yp(4)- yp(3) -.2
        call scale(dxp,dyp,xp,yp,4,ier)
        if(ier.ne.0) then
          print *,'error in subroutine scale'
          pause 'press ENTER to return to menu'
          stop
        endif
        call neatl
c*****PLOT AXES
        call xaxis(dxp,dyp,xp,adelx,lintx,sizex,
     &  ifmtx,ncharx)
        call yaxis(dyp,dxp,yp,adely,linty,sizey,
     &  ifmty,nchary)
c*****PLOT DATA
        rewind iswt
        do 14 i = 1,ic
        if(ifmtv.eq.' ') then
	   read( iswt, end=235,err=250,iostat=icheck ) x, y, z
        else
	   read( iswt, *, end=235,err=250,iostat=icheck ) x, y, z
        endif
        call vchar(x,y,4,1,2,.06,0.,0.,0.)
c        write(sta,'(f8.2)') z
c        n = leftj(sta)
c        call vchar(x,y,jsta,n,2,.10,.3,.1,0.)
14      continue
235     call endpt(idim)
       return
250    print *,'error no. ',icheck,' reading input data'
9999   pause 'press ENTER to return to menu'
       return
	end
c***************************************
      subroutine setax(x,dx,maxint,nch,fmt)
c  adjust interval and labeling format
c  input x-min max range, optional dx-spacing and
c  maxint-intervals
c  returns dx, nch-number of significant figures, fmt-labeling
c  format
      dimension x(2)
      character fmt*(*)
      ixpn(r)=int(alog10(abs(r))+100.)-100
      fmt='(1pe13.6)'
      nch=13
      if(dx.ne.0.) go to 5
      if(maxint.le.0) maxint=20
      t=abs(x(2)-x(1))/float(maxint)
      if(t.lt.1.e-20) return
      p10=10.**ixpn(t)
      p10=sign(1.0,t)*p10
      t1=t/p10
      if(t1.le.1.0) dx=p10
      if(t1.gt.1.0) dx=2.*p10
      if(t1.gt.2.0) dx=5.*p10
      if(t1.gt.5.0) dx=10.*p10
    5 idecm=0
      n10=ixpn(dx)
      if(n10.lt.0) idecm=iabs(n10)
      n10=ixpn( amax1(abs(x(1)),abs(x(2))) )
      iw=4+idecm
      if(n10.ge.0) iw=3+n10+idecm
      if(iw.gt.9) go to 11
      write(fmt,10) iw,idecm
   10 format('(f',i1,'.',i1,')' )
      nch=iw
      if(idecm.eq.0) nch=nch-1
   11 return
      end
c***********************************************************************
      subroutine opnsta(ista,ifile2,ifmtv,ierr,*)
      character*(*) ifile2,ifmtv
      character*1 resp
      logical exists,opn
      ierr=0
      inquire(file=ifile2,exist=exists)
        if(.not.exists) then
          print *,'can''t find file ',ifile2
          ifile2=' '
          write(*,'(a\)') ' TRY AGAIN ? [y]: '
          read(*,'(a)') resp
          if(resp.eq.'n'.or.resp.eq.'N') then
            ierr=1
            return 
          else
            return 1
          endif
        endif
        inquire(unit=ista,opened=opn)
          if(opn) close(ista)
        open(unit=ista,file=ifile2,
     &  status='old',err=442,iostat=icheck)
        read(ista,*,err=442,end=442,iostat=icheck) x,y,z
        rewind ista
        ifmtv(1:1) = '*'
        return
442     close(ista)
        open(unit=ista,file=ifile2,form='unformatted',
     &  status='old',err=443,iostat=icheck)
        read(ista,err=444,end=444,iostat=icheck) x,y,z
        nword = lenrec(ista,'u')
        if(nword.ne.3.and.nword.ne.-1) go to 444
        ifmtv = ' '
        return
443    print *,'error no. ',icheck,' with file: ',ifile2
       go to 445
444    print *,'file is not an xyz file'
445    ifile2=' '
       close(ista)
       ierr = 1
       return 
       end
c***********************************************************************
	function lenrec( ista,rtype )
c  brute force recovery of record length
       parameter(nwork=50)
	real irec(nwork)
       character*1 rtype

	istep = 10
	rewind ista

	do 5 max = istep, nwork, istep
         if(rtype.eq.'u') then
           read( ista, err=10 ) ( irec(i), i=1, max )
         else
	    read( ista,*, err=10 ) ( irec(i), i=1, max )
         endif
	  rewind ista
5       continue
	lenrec = -1
	go to 99

10	rewind ista
	do 30 j = max, max - istep, -1
         if(rtype.eq.'u') then
	    read( ista, err=20 ) ( irec(i), i=1, j )
         else
	    read( ista,*, err=20 ) ( irec(i), i=1, j )
         endif
	  lenrec=j
	  go to 99
20	  rewind ista
30      continue

99	rewind ista
	return
	end
