* file: testwk.f - last change: 9/5/95     (c) 1993 Christine Young-Molling
*
*       Reads UWM/COADS 1/2x1/2 degree weekly climatology 
*       files and prints portion of it on the screen.
*       This program demonstrates routine RDNCCW.
*

      parameter ( IDIM = 720, JDIM = 360, NDIM = IDIM * JDIM )

      real           A(idim,jdim)
      character*80   label, fname, units

*...........................................................................

      print *
      print *, '     << Printing UWM-COADS Files >>'
      print *


c     Sample file provided
c     --------------------
      print *, 'INPUT file name: '
      read(*,'(a80)') fname
      print *, fname(1:78)

*........................................................................

      do 50  iweek = 1, 52, 25

         print *
         print *, 'week = ', iweek
         write(10,*)
         write(10,*) 'week = ', iweek

*        Read Array
*        ----------
         call RDNCCW ( A, idim, jdim, units, label, fname, iweek )

         ll = index ( label, '$' ) - 1

*        Print portion of it on the screen
*        ---------------------------------
         call PUTOUT ( a, idim, jdim, label(1:ll) )
 
 50   continue

      stop 
      
      end

*........................................................................

      subroutine PUTOUT ( a, idim, jdim, string )

      real a(idim,jdim)
      character*(*) string

*        This subroutine prints a portion of the
*     input array, generally corresponding to the 
*     North Atlantic.
*
*        This routine is resolution dependent.

      data i1, i2, idel / 600, 720, 16 / 
      data j1, j2, jdel / 340, 180, -8 /
***      data iu / 6 /
      data iu / 10 /

*     Prints the array a
*     ------------------
      write(iu,*) 
      write(iu,*) string
      call PRARR ( a, idim, jdim, i1, i2, idel, j1, j2, jdel, iu)

***   read *

      return
      end

*......................................................................

      subroutine PRARR ( a, idim, jdim, i1, i2, idel, j1, j2, jdel, iu)

*       This routine prints out an array.


      real         a(idim,jdim)
      character*8  ac(360)

      parameter ( ALAND = -1. E 10, AMISS = +1. E 10 )


      do 20 j = j1, j2, jdel
         do 10 i = i1, i2, idel
            if ( a(i,j) .eq. AMISS ) then
               ac(i) = '    M   '
            else if ( a(i,j) .eq. ALAND ) then
               ac(i) = '    L   '
            else
               write(ac(i),'(1pe8.1)') a(i,j)
            end if
 10      continue
         write(iu,100) ( ac(i), i = i1, i2, idel )
 100     format(80(1x,a8))
 20   continue

      return
      end