!
!##################################################################
!##################################################################
!######                                                      ######
!######              SUBROUTINE RDSATFLD                     ######
!######                                                      ######
!######                  Developed by                        ######
!######    Center for Analysis and Prediction of Storms      ######
!######             University of Oklahoma.                  ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE rdsatfld(nx,ny,nfield,                                       & 3,1
           sfname,satname,latsat,lonsat,                                &
           itime,isource,fldname,satfld,istatus)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Reads remapped satellite data to a file as one or
!  more 2-d fields.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Keith Brewster
!  09/20/97
!
!  MODIFICATION HISTORY:
!
!
!-----------------------------------------------------------------------
!
!  INPUT:
!    nx,ny     horizontal dimensions
!    nfield    number of satellite fields to write
!    sfname    satellite file name (character string)
!    satnam    satellite name (character*6)
!    latsat    sub-satellite latitude (degrees N)
!    lonsat    sub-satellite longitude (degrees E)
!    itime     time, seconds since 1960
!    isource   source number
!                1= GVAR raw 2-byte data file
!                2= IDD 1-byte datafeed
!    fldname   name of variable(s) (character*6 array)
!    satfld    satellite data
!
!  OUTPUT:
!    data are written to file
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
  INTEGER :: nx,ny
  INTEGER :: nfield
  CHARACTER (LEN=*) :: sfname
  CHARACTER (LEN=6) :: satname
  REAL :: latsat
  REAL :: lonsat
  INTEGER :: itime
  INTEGER :: isource
  CHARACTER (LEN=6) :: fldname(nfield)
  REAL :: satfld(nx,ny,nfield)
  INTEGER :: istatus
!
!-----------------------------------------------------------------------
!
!  Misc local variables
!
!-----------------------------------------------------------------------
!
  CHARACTER (LEN=80) :: dummy_name
  INTEGER :: iunit,iopen
  INTEGER :: idummy
  INTEGER :: nxin,nyin,nfieldin
  REAL :: rdummy
!
!-----------------------------------------------------------------------
!
!  Include files
!
!-----------------------------------------------------------------------
!
  INCLUDE 'globcst.inc'
  INCLUDE 'grid.inc'        ! Grid parameters
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
  PRINT *, ' sfname= ',sfname
  PRINT *, ' nx,ny,nfield= ',nx,ny,nfield
!
  CALL getunit(iunit)
!
!-----------------------------------------------------------------------
!
!  Open file for reading
!
!-----------------------------------------------------------------------
!
  OPEN(iunit,IOSTAT=iopen,FILE=trim(sfname),STATUS='old',               &
       FORM='unformatted')

  IF(iopen == 0) THEN
!
!-----------------------------------------------------------------------
!
!  Read satellite description variables
!
!-----------------------------------------------------------------------
!
    READ (iunit,ERR=200) satname
    READ (iunit,ERR=200) nxin,nyin,nfieldin,itime,idummy,               &
                         idummy,idummy,idummy,idummy,idummy
!
!-----------------------------------------------------------------------
!
!  Check dimensions of incoming data.
!
!-----------------------------------------------------------------------
!
    IF ( nxin /= nx .OR. nyin /= ny .OR. nfieldin /= nfield) THEN
      WRITE(6,'(a,/a)') ' Error reading satellite data file',sfname
      WRITE(6,'(a,i5,a,i5,a,i3)') ' File has data at nx=',nxin,         &
                    '  ny=',nyin,'  nfield=',nfieldin
      WRITE(6,'(a,i5,a,i5,a,i3)') ' Expected data at nx=',nx,           &
                    '  ny=',ny,'  nfield=',nfield
      WRITE(6,'(a)') ' Adjust program dimensions'
      STOP
    END IF
!
!-----------------------------------------------------------------------
!
!  Read grid description variables
!  This should provide enough info to uniquely identify the 2-d grid.
!
!-----------------------------------------------------------------------
!

    READ (iunit,ERR=200) dummy_name
    READ (iunit,ERR=200) idummy,strhopt,mapproj,idummy,idummy,          &
                 idummy,idummy,idummy,idummy,idummy
    READ (iunit,ERR=200) dx,dy,dz,dzmin,ctrlat,                         &
                 ctrlon,trulat1,trulat2,trulon,sclfct,                  &
                 latsat,lonsat,rdummy,rdummy,rdummy
!
!-----------------------------------------------------------------------
!
!  Read 2-d fields.
!
!-----------------------------------------------------------------------
!
    READ(iunit,ERR=200) fldname
    READ(iunit,ERR=200) satfld
!
    CLOSE(iunit)
    CALL retunit(iunit)
!
!-----------------------------------------------------------------------
!
!  Report on what data were read
!
!-----------------------------------------------------------------------
!
    WRITE(6,'(//a,a,a,a)') ' Read ',fldname(1),' from ',satname
!
    PRINT *, ' satname= ',satname
    PRINT *, ' lat,lon= ',latsat,lonsat
    PRINT *, ' itime= ',itime
    PRINT *, ' isource = ',isource
    PRINT *, ' fldname= ',fldname(1)
    PRINT *, ' satfld(1,1,1)= ',satfld(1,1,1)
    PRINT *, ' satfld(nx,ny,1) = ',satfld(nx,ny,1)

    istatus=0

  ELSE

    istatus=iopen

  END IF

  RETURN

  200 CONTINUE

  istatus=-1

  RETURN
END SUBROUTINE rdsatfld