!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE WTSATFLD ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma. ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE wtsatfld(nx,ny,nfield, &,2
sfname,satname,latsat,lonsat, &
iyr,imon,iday,ihr,imin,isec,isource, &
fldname,satfld)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Writes 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)
! iyr year
! imon month
! iday day
! ihr hour
! imin min
! isec sec
! 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=100) :: sfname
CHARACTER (LEN=6) :: satname
REAL :: latsat
REAL :: lonsat
INTEGER :: iyr,imon,iday,ihr,imin,isec
INTEGER :: isource
CHARACTER (LEN=6) :: fldname(nfield)
REAL :: satfld(nx,ny,nfield)
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
INTEGER :: iunit,myr,itime
INTEGER :: idummy
REAL :: rdummy
!
!-----------------------------------------------------------------------
!
! Include files
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'grid.inc'
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
PRINT *, ' nx,ny,nfield= ',nx,ny,nfield
PRINT *, ' sfname= ',sfname
PRINT *, ' satname= ',satname
PRINT *, ' lat,lon= ',latsat,lonsat
PRINT *, ' iyr,imon,iday= ',iyr,imon,iday
PRINT *, ' ihr,imin,isec= ',ihr,imin,isec
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)
!
myr=1900+iyr
IF(myr < 1960) myr=myr+100
CALL ctim2abss
(myr,imon,iday,ihr,imin,isec,itime)
!
CALL getunit
(iunit)
!
!-----------------------------------------------------------------------
!
! Open file for output
!
!-----------------------------------------------------------------------
!
OPEN(iunit,FILE=sfname,STATUS='unknown', &
FORM='unformatted')
!
!-----------------------------------------------------------------------
!
! Write satellite description variables
!
!-----------------------------------------------------------------------
!
idummy=0
rdummy=0.
WRITE(iunit) satname
WRITE(iunit) nx,ny,nfield,itime,idummy, &
idummy,idummy,idummy,idummy,idummy
!
!-----------------------------------------------------------------------
!
! Write grid description variables
! This should provide enough info to uniquely identify the 2-d grid.
!
!-----------------------------------------------------------------------
!
WRITE(iunit) runname
WRITE(iunit) hdmpfmt,strhopt,mapproj,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy
WRITE(iunit) dx,dy,dz,dzmin,ctrlat, &
ctrlon,trulat1,trulat2,trulon,sclfct, &
latsat,lonsat,rdummy,rdummy,rdummy
!
!-----------------------------------------------------------------------
!
! Write 2-d fields.
!
!-----------------------------------------------------------------------
!
WRITE(iunit) fldname
WRITE(iunit) satfld
!
CLOSE(iunit)
CALL retunit(iunit)
!
!-----------------------------------------------------------------------
!
! Report on what data were written
!
!-----------------------------------------------------------------------
!
WRITE(6,'(//a,i2.2,i2.2,i2.2,a1,i2.2,a1,i2.2)') &
' Wrote satellite fields for time ', &
iyr,imon,iday,' ',ihr,':',imin
!
RETURN
END SUBROUTINE wtsatfld