C+
C NAME:
C	smei_orb_write
C PURPOSE:
C	Write orbital pattern file
C CATEGORY:
C	ucsd/camera/for/lib
C CALLING SEQUENCE:
	subroutine smei_orb_write(version,bForce,bDiff,cDest,cPatCal,min_orbit,this_orbit,
     &		tfirst,tlast,tlow,thigh,nframe,nx,ny,ip_orb,ip_frac,orb_pattern,cthis_orbit)
C INPUTS:
C	version		double precision smei_orb version number
C	bForce  	logical		.FALSE.: do not overwrite existing pattern (if a pattern
C						exists, execution is aborted).
C					.TRUE. : overwrite pattern (the existing pattern file
C						is deleted, and a new one is written)
C	bDiff		logical		.FALSE.: write minimum pattern
C					.TRUE. : write difference pattern
C	cDest*(*)	character	destination directory for orbit pattern files
C	cPatCal*(*)	character	name of closed shutter calibration pattern on which
C					the orbital pattern is based
C	min_orbit	integer		minimum orbit
C	this_orbit	integer		curent orbit (either minimum orbit or a difference orbit)
C	tfirst(2)	integer		time of first frame in orbit
C	tlast(2)	integer		time of last frame in orbit
C	tlow(2)		integer		start time of fraction of orbit used
C	thigh(2)	integer		end time of fraction of orbit used
C	nframe(2)	integer		nframe(1): # frames in orbit this_orbit
C					nframe(2): # frames used
C	nx		integer		horizontal dimension of orbital pattern
C	ny		integer		vertical dimension of orbital pattern
C	ip_orb		integer
C	ip_frac		integer
C	orb_pattern(*)	real
C OUTPUTS:
C	cthis_orbit*(*)	character	name of output file
C INCLUDE:
	include		'filparts.h'
	include		'smei_frm_layout.h'
C CALLS:
C	iSetFileSpec, iGetFileSpec, iFilePath, iGetLun, iFreeLun
C	say_fts, Time2Str, Time2Delta, Time2System, Int2Str, Str2Str, Say
C	FTINIT, FTPKNS, FTPKYS, FTPKYE, FTPKYL, FTCRHD, FTPHPR, FTPPRE, FTCLOS
C	ArrR4Copy, ArrR4Mask, ArrR4Zero, BadR4, iOSDeleteFile, smei_orb_mkname
C PROCEDURE:
C	How many bad values do we expect????
C MODIFICATION HISTORY:
C	JUN-2004, Paul Hick (UCSD/CASS)
C	JUL-2006, Paul Hick (UCSD/CASS)
C	    Added Fits keyword SMEI_ORB (version number) and CREATED
C	    (time file is created).
C	APR-2007, Paul Hick (UCSD/CASS)
C	    Added keyword IFRAME (number of frames used).
C	    Pattern name determined from tfirst by calling smei_orb_mkname.
C	DEC-2007, Paul Hick (UCSD/CASS; pphick@ucsd.edu)
C	    Changed keyword CREATED to DATE (consistent with IDL)
C-
	    double precision version
	    logical	bForce
	    logical	bDiff
	    character	cDest*(*)
	    character	cPatCal*(*)
	    integer	min_orbit
	    integer	this_orbit
	    integer	tfirst(*)
	    integer	tlast (*)
	    integer	tlow  (*)
	    integer	thigh (*)
	    integer	nframe(*)
	    integer	nx
	    integer	ny
	    integer	ip_orb
	    integer	ip_frac
	    real	orb_pattern(*)
	    character	cthis_orbit*(*)

	character	cSay*9		/'orb_write'/
	character	cSeverity	/'E'/

	logical		bSimple		/.TRUE./	! Conforms to FITS standard
	integer		iBitPix		/   -32/	! Real*4 array
	integer		nAxis		/     2/	! Two dim array
	integer		nAxes(2)
	logical		bExtend		/.TRUE./	! Allows FITS extensions

	integer		time(2)

	integer		Str2Str
	integer		Time2Str

	character	cFile*(FIL__LENGTH)
	character	cStr *(FIL__LENGTH)

	character	cmin_orbit*(FIL__LENGTH)	/' '/
	save		cmin_orbit

	real		out_pattern(SMEI__FRM_NPIX)

	! The first time this function is called to write the mimimum pattern.
	! Set up the name for the minimum pattern only once and save it
	! internally for subsequent calls to write the difference patterns.

	if (cmin_orbit .eq. ' ') then
	    call smei_orb_mkname(tfirst,cmin_orbit)
	    cmin_orbit(3:5) = 'min'
	end if

	if (bDiff) then
	    call smei_orb_mkname(tfirst,cthis_orbit)
	else
	    cthis_orbit = cmin_orbit
	end if

	badvalue = 0.0

	iFile = iFilePath(cDest,0,' ',cthis_orbit,cFile)
	cFile(iFile+1:) = '.fts.gz'

	if (bDiff) then
	    call Say(cSay,'I','#'//cFile,'difference pattern')
	else
	    call Say(cSay,'I','#'//cFile,'minimum pattern')
	end if

	! Delete pattern file if bForce is set.

	if (bForce) then
	    istat = iOSDeleteFile(cFile)
	!else
	!    if (iSearch(11,cFile,cFile) .eq. 1) then
	!	call Say(cSay,'W','#'//cFile,'exists -> skip')
	!	return
	!    end if
	end if

	! Write FITS file

	iU = iGetLun(cFile)

	istat = 0	! Initialize to zero
			! Stays zero as long as there are no FITS errors
	call FTINIT(iU, cFile, 1, istat)

	if (istat .eq. 105) then
	    iU = iFreeLun(iU)
	    call Say(cSay,'W','#'//cFile,'exists -> skip')
	    return
	end if

	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	! Write pattern as primary data

	nAxes(1) = nx
	nAxes(2) = ny

	! Write primary header

	call FTPHPR(iU, bSimple, iBitPix, nAxis, nAxes, 0, 1, bExtend, istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYG(iU, 'SMEI_ORB', version, 2, 'Software version number', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

        call Time2System(time)                          ! File creation time
        i = Time2Str('YYYY-MN-DD hh:mm', time, cStr)

        call FTPKYS(iU, 'DATE', cStr(:i), 'Creation UTC (CCCC-MM-DD) date of FITS header', istat)
        if (istat .ne. 0) call say_fts(cSayFts,cSeverity,istat)

	i = Time2Str(SMEI__UT_FORMAT, tfirst, cStr)
	call FTPKYS(iU, 'T_FIRST', cStr(:i), 'First frame', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	i = Time2Str(SMEI__UT_FORMAT, tlast, cStr)
	call FTPKYS(iU, 'T_LAST', cStr(:i), 'Last frame', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	i = Time2Str(SMEI__UT_FORMAT, tlow, cStr)
	call FTPKYS(iU, 'T_LOW', cStr(:i), 'Begin of orbit fraction', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	i = Time2Str(SMEI__UT_FORMAT, thigh, cStr)
	call FTPKYS(iU, 'T_HIGH', cStr(:i), 'End of orbit fraction', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYJ(iU, 'NFRAME', nframe(1), 'Number of frames in orbit',istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYJ(iU, 'IFRAME', nframe(2), 'Number of frames used', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYE(iU,'BAD_DATA', badvalue, 5, 'Missing data flag', istat)  
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	! Names of relevant patterns

	call FTPKYS(iU, 'NAME', cthis_orbit(:itrim(cthis_orbit)), 'Name of pattern', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	if (bDiff) then
	    call FTPKYS(iU, 'IMG_TYPE', 'orbframe', 'Image type', istat)
	else
	    call FTPKYS(iU, 'IMG_TYPE', 'minframe', 'Image type', istat)
	end if

	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYJ(iU, 'ORBIT', this_orbit, 'Number of orbit', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYS(iU, 'MIN_NAME', cmin_orbit(:itrim(cmin_orbit)), 'Orbital minimum pattern', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYJ(iU, 'MIN_ORB', min_orbit, 'Number of minimum orbit', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYS(iU, 'CAL_NAME', cPatCal(:itrim(cPatCal)), 'Shutter closed calibration pattern', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call ArrR4Copy(nx*ny,orb_pattern(ip_orb+1),out_pattern)
	call ArrR4Mask(nx*ny,out_pattern,BadR4(),badvalue,0.0,0.0,1.0,out_pattern)

	call FTPPRE(iU, 0, 1, nx*ny, out_pattern, istat)	! Write pattern data
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTCRHD(iU,istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPHPR(iU, bSimple, iBitPix, nAxis, nAxes, 0, 1, bExtend, istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)
	
	call ArrR4Copy(nx*ny,orb_pattern(ip_frac+1),out_pattern)
	call ArrR4Mask(nx*ny,out_pattern,BadR4(),badvalue,0.0,0.0,1.0,out_pattern)

	call FTPPRE(iU, 0, 1, nx*ny, out_pattern, istat)	! Write pattern data
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTCLOS(iU, istat)					! Close pattern fts file
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	iU = iFreeLun(iU)

	return
	end