program report

*** report on a grid file

      implicit double precision(a-h,o-z)
      character*63 fname
      integer*2 irec(30000)
      integer hrec(30000)
      real*4  zrec(30000),nw,ne,sw,se,zmin,zmax
      equivalence(hrec(1),zrec(1))
      ave=0.d0
      rms=0.d0
      std=0.d0

      lin=1

      write(6,*) 'program report'
      write(6,1) 
    1 format('Enter file name: ',$)
      read(5,'(a)') fname
      open(lin,file=fname,status='old',form='unformatted')

*** display header contents

      read(lin) glamn,glomn,dgla,dglo,nla,nlo,ikind
      write(6,*)
      write(6,*) 'kind=',ikind
      write(6,*) 'LAT  min=',glamn
      write(6,*) '     del=',dgla,'    # lat=',nla
      write(6,*) '     max=',glamn+(nla-1)*dgla
      write(6,*) 'LON  min=',glomn
      write(6,*) '     del=',dglo,'    # lon=',nlo
      write(6,*) '     max=',glomn+(nlo-1)*dglo

*** read records south to north (elements are west to east)

      zmin=+1.e20
      ilamn=0
      ilomn=0
      zmax=-1.e20
      ilamx=0
      ilomx=0
      nzero=0
      if(ikind.eq.-1) then
          do irow=1,nla
            read(lin) (irec(i),i=1,nlo)
            do i=1,nlo
               zrec(i)=irec(i)/10.0 +3000.0
            enddo
            if(irow.eq.1) then
              sw=zrec(1)
              se=zrec(nlo)
            elseif(irow.eq.nla) then
              nw=zrec(1)
              ne=zrec(nlo)
            endif
            do i=1,nlo

              val = dble(zrec(i))
              ave = ave + val   
              rms = rms + val*val
c            if(i.eq.1)write(6,*) ' row,val*val,rms=',irow,val*val,rms

              if(abs(zrec(i)).lt.1.e-7) nzero=nzero+1
              if(zrec(i).lt.zmin) then
                zmin=zrec(i)
                ilamn=irow
                ilomn=i
              endif
              if(zrec(i).gt.zmax) then
                zmax=zrec(i)
                ilamx=irow
                ilomx=i
              endif
            enddo
          enddo
      elseif(ikind.eq.0) then
        do 9 irow=1,nla
          read(lin) (hrec(i),i=1,nlo)
c         write(6,*) ' read row # ',irow
          if(irow.eq.1) then
            sw=hrec(1)
            se=hrec(nlo)
          elseif(irow.eq.nla) then
            nw=hrec(1)
            ne=hrec(nlo)
          endif
          do 8 i=1,nlo

            val = dble(hrec(i))
            ave = ave + val     
            rms = rms + val*val

            if(hrec(i).eq.0) nzero=nzero+1
            if(hrec(i).lt.zmin) then
              zmin=hrec(i)
              ilamn=irow
              ilomn=i
            endif
            if(hrec(i).gt.zmax) then
              zmax=hrec(i)
              ilamx=irow
              ilomx=i
            endif
    8     continue
    9   continue
      else
        do 7 irow=1,nla
          read(lin) (zrec(i),i=1,nlo)
c         write(6,*) ' read row # ',irow
          if(irow.eq.1) then
            sw=zrec(1)
            se=zrec(nlo)
          elseif(irow.eq.nla) then
            nw=zrec(1)
            ne=zrec(nlo)
          endif
          do 6 i=1,nlo

            val = dble(zrec(i))
            ave = ave + val   
            rms = rms + val*val
c           if(i.eq.1)write(6,*) ' row,val*val,rms=',irow,val*val,rms

            if(abs(zrec(i)).lt.1.e-7) nzero=nzero+1
            if(zrec(i).lt.zmin) then
              zmin=zrec(i)
              ilamn=irow
              ilomn=i
            endif
            if(zrec(i).gt.zmax) then
              zmax=zrec(i)
              ilamx=irow
              ilomx=i
            endif
    6     continue
    7   continue
      endif

      nnn = nla*nlo
      nn1 = nnn-1
      fact = dble(nnn)/dble(nn1)

      ave = ave /nnn
      rms = dsqrt(rms /nnn)
      std = dsqrt(fact*(rms**2 - ave**2))
 
      write(6,*) 'nw,ne,sw,se --> ',nw,ne,sw,se
c     write(6,*) 'min -> max  --> ',zmin,zmax,
c    * '   la,lo,(mn->mx)',ilamn,ilomn,' -> ',ilamx,ilomx
      write(6,*) 'min -> ',zmin,
     * '   la,lo',ilamn,ilomn,
     *            glamn+(ilamn-1)*dgla,glomn+(ilomn-1)*dglo
      write(6,*) 'max -> ',zmax,
     * '   la,lo',ilamx,ilomx,
     *            glamn+(ilamx-1)*dgla,glomn+(ilomx-1)*dglo
      write(6,*) 'ave/std/rms ->',ave,std,rms
      write(6,*) nzero,' of',nla*nlo,' elements are zero.'

      stop
      end