c  program xyzmax
c
c  addition: internally, x=channel 1, y=channel 2, and dependant
c  variables start with channel 3.  Screen prompts and output correct
c  this absurdity with x=x, y=y, and channel 1 = channel 1, etc.
c

	parameter  ( maxbuf=1024, maxpst=52, maxchn=maxpst-2 )
      dimension  ibuff(1024), xmin(maxchn), xmax(maxchn), za(maxchn)
        character  ifile*80, ifmt*80, blank*80, chan*1
	logical    binary, expres, post

1	format( a )
	iswt  = 10
	ifmt  = ' '
	blank = ' '
	post  = .false.
	ic    = 0

c  standard gravity format
	ifmt = '(22x,f2.0,f4.2,f4.0,f4.2,f6.2)'

	do i = 1, maxchn
	  xmin(i) = 1.e30
	  xmax(i) = -xmin(i)
	enddo

      print 10
10	format(' enter filename :'$)
	read(5,1) ifile

      call openf( iswt, ifile, ibuff, maxpst, binary, expres,
     1           nword, maxlog, ntotal )

c  set function switches
	ifunc = 0
	if ( binary  .and.  nword .gt. 3 ) then
	  ifunc = 2
	  post  = .true.
	endif
	if ( binary  .and.  nword .eq. 3 ) then
	  ifunc = 3
	  post  = .false.
	endif
	if ( expres ) ifunc = 1

	if ( ifunc .eq. 0 ) then
20      print *,'enter 4 (formatted xyz) or 5 (std gravity):'
	  read( 5, *, err=20 ) ifunc
	  if ( ifunc .lt. 4   .or.   ifunc .gt. 5 ) go to 20
	endif

	nchn = nword - 2
	is   = 1
	ie   = 3

	if ( post ) then
59      ie=nchn
        print '(a\)', ' enter ending channel number [',nchn,']: '
        read(5,*) ie
        is=1
        ie=ie+2
        if ( ie .gt. nchn ) go to 59
	  if ( is .le. 0    ) go to 59
        if ( is .gt. ie   ) go to 59
        else if (ifunc .eq. 4 ) then
          print *, ' enter format ( car ret for free field ) :'
	    read(5,1) ifmt
	    if ( ifmt .eq. blank ) ifunc = 6

	    else if ( ifunc .eq. 5 ) then
	      do 80 i = 1, 3
80	      read( iswt, ifmt, end=999 )
	endif

c  start read loop 
	go to ( 110, 120, 130, 140, 150, 160 ) ifunc

110   call expr( iswt, ibuff, nword, maxlog, is, ie,
     1          xmin, xmax, maxchn, ic )
	go to 200

120	call postr( iswt, za, ie,   is, ie, 
     1          xmin, xmax, maxchn, ic )
	go to 200

130	read( iswt, end=200 ) x, y, z
	go to 190

140	read( iswt, ifmt, end=200 ) x, y, z
	go to 190

150	read( iswt, ifmt, end=200 ) yd,ym,xd,xm,z
	x = xd + xm * sign( 1.666667e-2, xd )
	y = yd + ym * 1.666667e-2
	go to 190

160	read( iswt, *, end=200 ) x, y, z

190	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 ( 110, 120, 130, 140, 150, 160 ) ifunc

200   continue
      rang=xmax(1)-xmin(1)
c      print 231, xmin(1),xmax(1),rang
c231   format(' # x min= ',1pg15.6,'  max= ',g15.6,' range=',g15.6)
      print*,'# x min = ',xmin(1),' max = ',xmax(1),' range = ',rang
      rang=xmax(2)-xmin(2)
c      print 232, xmin(2),xmax(2),rang
c232   format(' # y min= ',1pg15.6,'  max= ',g15.6,' range=',g15.6,/)
      print*,'# y min = ',xmin(2),' max = ',xmax(2),' range = ',rang
      do i = 3,ie
        ii=i-2
        chan=char(ii+48)
	  rang = xmax(i) - xmin(i)
c        print 230, ii, xmin(i), xmax(i), rang
c230       format(' #', i2, ' min= ', 1pg15.6, '  max= ', g15.6,
c     1                  ' range=',g15.6 )
      print*,'# ',chan,' min = ',xmin(i),' max = ',xmax(i),
     1' range = ',rang
	enddo

240   print *, ic, ' logical records in the file'
	close(10)
	stop
999	close(10)
	stop ' premature end of file'
	end
c******************************************************************************
	subroutine postr( iswt, z, nchn, is, ie, 
     1                xmin, xmax, maxchn, ic )
	dimension z(nchn), xmin(maxchn), xmax(maxchn)
	character id*8

	ic=0
5     read(iswt,end=99) id, z
	ic = ic + 1
	do i = is, ie
	  if ( z(i) .lt. xmin(i) ) xmin(i) = z(i)
	  if ( z(i) .gt. xmax(i) ) xmax(i) = z(i)
	enddo
	go to 5
99	return
	end
c*******************************************************************************
      subroutine expr( iswt, ibuff, nword, maxlog, is, ie,
     1                xmin, xmax, maxchn, ndat )

      dimension  ibuff(nword,maxlog), xmin(maxchn), xmax(maxchn)

	ncharw = 0
	if ( nword .gt. 3 ) ncharw = 2

	nrec = 0
	ntxt = 0
	ndat = 0

	do 100 irec = 1, 9 999 999

        read( iswt, rec=irec, err=200 ) nw, nlog, nt, ibuff
	  nrec = nrec + 1
	  if ( nlog .lt. 0 ) then 
	    ntxt = ntxt + 1
	    go to 100
	  endif

	  do j = 1, nlog
	    ndat = ndat + 1
	    do i = is, ie
            b = ibuff(i+ncharw,j)
	      if ( b .lt. xmin(i) ) xmin(i) = b
	      if ( b .gt. xmax(i) ) xmax(i) = b
	    enddo
	  enddo

100	continue

200   print *, ' total number of records in file =', nrec
      print *, ' number of text records          =' , ntxt

	return
	end
c*******************************************************************************
      subroutine openf( iswt, ifile, ibuff, maxpst, binary, expres,
     1                 nword, maxlog, ntotal )

c  open data file, derive and checkout file structure.
c
c  input file types:
c  xyz      single record xyz data.
c  post     single record containing an id (8 characters), x, y, and
c           1-n dependant-variable channels. Normally n=6, but this
c           program accepts more channels.
c
c  Note: express file options deleted for PC version 1 series.

	parameter  ( maxbuf=1024 )
      dimension  ibuff(maxbuf)
	character  ifile*(*)
	logical    binary, expres
	nword  = 0
	maxlog = 0
	ntotal = 0
	binary = .false.
	expres = .false.

c  open binary
	open( unit=iswt, file=ifile, status='old', form='unformatted',
     1     mode='read', iostat=ios )
	if ( ios .ne. 0 ) then
        print *,' error opening input data file ( cannot find )'
	  stop
	endif

c  binary or ascii input ?
	read( iswt, err=10, iostat=ios ) itest
10	rewind( iswt )
	if ( ios .eq. 0 ) then
	  binary = .true. 
	  else
	  close( iswt ) 
	  go to 100
	endif

c  file is binary
c  lenrec returns zero if buffer is too short
      nword = lenrec( iswt, ibuff, maxpst )
	if ( nword .eq. 1  .or.  nword .eq. 2 ) go to 200

c  simple xyz file.
	if ( nword .eq. 3 ) then
        print *, ' binary xyz data'
	  go to 999
	endif

c  simple post file.
	if ( nword .ge. 4   .and.   nword .le. maxpst ) then
        nchan  = nword - 2
        nnchan=nchan-2
        print *, ' post data,  found', nnchan, ' data channels'
	  go to 999
	endif


c  open for ascii input
100	  open( unit=iswt, file=ifile, status='old', form='formatted', 
     1       mode='read' )
	go to 999

c  record length undefined.
200   print *, ' input record length =', nword
      print *, ' input is neither xyz or post'

999	return
	end
c******************************************************************************
	function lenrec( iswt, irec, nwork )
c  brute force recovery of record length
	dimension irec(nwork)

	istep = 10
	if ( nwork .gt. 100 ) istep = 20
	if ( nwork .gt. 500 ) istep = 50
	rewind iswt

	do max = istep, nwork, istep
	  read( iswt, err=10 ) ( irec(i), i=1, max )
	  rewind iswt
	enddo
	lenrec = -1
	go to 99

10	rewind iswt
	do lenrec = max, max - istep, -1
	  read( iswt, err=20 ) ( irec(i), i=1, lenrec )
	  go to 99
20	  rewind iswt
	enddo

99	rewind iswt
	return
	end
