program ex4
      implicit none

****
*     This program uses the RPN standard file functions
*     FSTINL, FSTLUK and FSTPRM to make queries about the 
*     contents of an RPN standard file.
*
*     Author: Yves Chartier
*     Last revision: September 1992.
****

****
*     Declare variables used by the RPN standard file library
****

      integer maxkeys
      parameter (maxkeys = 100)

      character*2 nomvar
      character*1 typvar, grtyp
      character*8 etiket
      
      integer keys(maxkeys), nkeys
      integer dateo, datev, deet, npas, ni, nj, nk
      integer npak, datyp, nbits
      integer ip1, ip2, ip3
      integer ig1, ig2, ig3, ig4
      integer swa, lng, dltf, ubc, extra1, extra2, extra3

****
*     Declare the name and type of the RPN standard file functions   
****
      integer fstecr, fstinl, fstsui, fstluk, fstprm
      integer fnom, fstouv, fclos, fstfrm

****
*     Declare other variables used by the program
****
      integer ier, nrecs
      integer i,j,ii,jj,iun, iunout
      integer month
      real fld(120, 60)
      real minval, maxval, avgval

****
*     Association of the RPN standard file produced by the
*     program with the FORTRAN logical unit 1.
****
      iun = 1

      ier = fnom(iun, 'ts.fst', 'STD+RND', 0)
      if (ier.lt.0) then
         print *, 'Fatal error while opening the file (FNOM)'
      endif

****
*     Opening of the standard file
****
      ier = fstouv(iun, 'RND')
      if (ier.lt.0) then
         print *, 'Cannot open unit:', iun, 
     *            ' in random access mode (FSTOUV)'
         stop
      endif
      
****  
*     Initialize standard file variables for doing a query
****  
      
      typvar = 'C'
      nomvar = 'TS'
      etiket = 'SFC TEMP '
      datev  = -1
      ip1 = 0
      ip2 = 0
      ip3 = 0
            
****  
*     Reads the first field meeting selection criteria
****  
      
      ier = fstinl(iun, NI, NJ, NK, datev, etiket, ip1, ip2, ip3,
     *             typvar, nomvar, keys, nkeys, maxkeys)
      if (ier.lt.0) then
         print *, '(FSTINL) No records found'
         go to 200
      endif
      
****  
*     Try to read the next field meeting selection criteria set
*     by the first call to FSTINF.
****  

      do 50 i=1,nkeys
         ier = fstluk(fld, keys(i), NI, NJ, NK)
****  
*     Computes minimum, maximum and average value of the field
****  
         call statfld(minval, maxval, avgval, fld, ni, nj)
****  
*     Get all standard file parameters and print them
****  
         ier  = fstprm(keys(i), dateo, deet, npas, ni, nj, nk, 
     *        nbits, datyp, ip1, ip2, ip3, 
     *        typvar, nomvar, etiket, grtyp,
     *        ig1, ig2, ig3, ig4, swa, lng, dltf, ubc, 
     *        extra1, extra2, extra3)
         
         print *, '*****************************************'
         print *, ' minval = ', minval, 'maxval =', maxval, 
     *        'avgval = ', avgval
         
         print 10, nomvar, typvar, etiket, dateo, deet, npas,
     *        ni, nj, nk,nbits, datyp, ip1, ip2, ip3,
     *        grtyp, ig1, ig2, ig3, ig4,
     *        swa, lng, dltf, ubc, extra1, extra2, extra3
         
 50   continue
****  
*     Close the standard file
****  
 200  ier = fstfrm(1)
      
****  
*     Unlink the unit 1 from the file "ts.fst"
****  
      ier = fclos(1)
      
 10   format(' ', ' nomvar=', a10, ' typvar=', a10, ' etiket=', a10, /, 
     *       ' ', ' dateo= ', i10, ' deet=  ', i10, ' npas=  ', i10, /, 
     *       ' ', ' ni=    ', i10, ' nj=    ', i10, ' nk=    ', i10, /, 
     *       ' ', ' nbits= ', i10, ' datyp= ', i10, /, 
     *       ' ', ' ip1=   ', i10, ' ip2=   ', i10, ' ip3=   ', i10, /,
     *       ' ', ' grtyp= ', a10, ' ig1=   ', i10, ' ig2=   ', i10, 
     *            ' ig3=   ', i10, ' ig4=   ', i10, /, 
     *       ' ', ' swa=   ', i10, ' lng=   ', i10, ' dltf=  ', i10, 
     *            ' ubc=   ', i10, /, 
     *       ' ', ' extra1=', i10, ' extra2=', i10, ' extra3=', i10)

      stop
      end
c     ****************************************************************
c     **                                                            **
c     ****************************************************************

      subroutine statfld(minval, maxval, avgval, fld, ni, nj)
      implicit none

      real minval, maxval, avgval
      real fld(ni,nj)
      integer i,j, ni, nj

      minval = fld(1,1)
      maxval = fld(1,1)
      avgval = 0.0
      
      do 100 j=1,nj
         do 100 i=1,ni
            avgval = avgval + fld(i,j)

            if (fld(i,j).lt.minval) then
               minval = fld(i,j)
            endif

            if (fld(i,j).gt.maxval) then
               maxval = fld(i,j)               
            endif

 100  continue

      avgval = avgval / (ni * nj)

      return
      end

c     ****************************************************************
c     **                                                            **
c     ****************************************************************