program ex2
      implicit none

****
*     This program uses the RPN standard file functions
*     FSTNBR, FSTVOI, FSTLIR 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
****
      character*2 nomvar
      character*1 typvar, grtyp
      character*8 etiket
      
      integer key, 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, fstlir, fstlis, fstprm
      integer fnom, fstouv, fclos, fstfrm, fstnbr, fstvoi, fsteof

****
*     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

****
*     Get the number of records in the standard file
****
      nrecs = fstnbr(iun)
      print *, 'There are ', nrecs, ' records in that file'

****
*     Print the contents of the standard file directory
****
      
      ier = fstvoi(iun, 'STD+RND')
      if (ier.lt.0) then
         print *, '(FSTVOI) Cannot print the directory'
      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
****

      key = fstlir(fld, iun, NI, NJ, NK, datev, etiket, 
     *             ip1, ip2, ip3, typvar, nomvar)

 50   if (key.lt.0) then
         print *, '(FSTLIR) Invalid key number:', key
      else
****
*        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(key, 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

****
*        Try to read the next field meeting selection criteria set
*        by the first call to FSTLIR.
****
         key  = fstlis(fld, iun, NI, NJ, NK)
         goto 50
      endif

****
*     Close the standard file
****
      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