! !################################################################## !################################################################## !###### ###### !###### 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