c  idmax.for  John Cady 12/22/92
c  Program combines functions of "id" and "grdmax" 
c  Programs types out the header of a standard grid file.
      character*50 infile
      dimension id(14),r(3000)
10    write(6,1)
1     format(1x,'Enter input file name:'1x,'*'$)
      read(5,2)infile
2     format(a50)
      open(10,file=infile,status='old',form='unformatted',
     & mode='read',err=99)
      read(10,err=22)id,pgm1,pgm2,nc,nr,nz,x0,dx,y0,dy,iproj,
     1cm,baslat
	go to 33
22    rewind 10
	read(10)id,pgm1,pgm2,nc,nr,nz,x0,dx,y0,dy
33    write(6,3)(id(i),i=1,14),pgm1,pgm2
	if(iproj.ne.0) then
		write(6,803) iproj,cm,baslat
803		format(' iproj=',i1,' central merid.= ',f11.6,
     1		' base lat.= ',g11.6)
	endif
3     format(1x,14a4,1x,2a4)
      write(6,4)nc,nr,nz
4     format(1x,'ncol =',0pi5,5x,'nrow =',i5,5x,'nz =',i3)
      write(6,5)x0,dx,y0,dy
5     format(1x,'x0 =',g14.7,2x,'dx =',g14.7,3x,'y0 =',g14.7,2x,'dy =',
     &g14.7)
     
c  Following code is from grdmax.for (JCady, 12/22/92)
	zmx   = -1.e37
	zmn   =  1.e37
	ndval =  0
      ave   =  0
      total=nc*nr

	do 20 j=1,nr
        call rowio(nc,r,-1,10,10,ier)
	if (ier.ne.0) then
	print 11,j
11	format(' eof before row ',i4)
	stop
	endif

	do 20 i=1,nc
	if ( r(i) .gt. 1.e37 ) then
	  ndval = ndval + 1
	  else if ( r(i) .gt. zmx ) then
	    zmx=r(i)
	    mxcol=i
	    mxrow=j
	  else if ( r(i) .lt. zmn ) then
	    zmn=r(i)
	    mcol=i
	    mrow=j
	endif
20	continue

	print 30, zmn, mcol, mrow
30	format(' min =',1pg20.7,'    col row ',2i4)
	print 40, zmx, mxcol, mxrow
40    format(' max =',1pg20.7,'    col row ',2i4)
      range=zmx-zmn
      pcent=ndval*100.0
      pcent=100.-(pcent/total)
      write(6,50)range,ndval,pcent
50    format(1x,'range=',e12.3,i10,' dvals;',f6.1,'% of'
     1 ' grid defined.')
       
	close(10)
      go to 300
99    print *,'Error opening file.  Try again.'
      go to 10
300   stop
      end
      
	subroutine rowio(n,z,iop,idev,jdev,iend)
c  read iop<0, write iop=0, r&w iop=1
	dimension z(n)
	iend=0
	if(iop)1,2,1
1	read(idev,end=10) y,z
	if(iop)9,9,2
2	write(jdev) y,z
9	return
10	iend=1
	return
	end

