C+
C NAME:
C	smei_cal_write
C PURPOSE:
C	Write closed shutter calibration pattern file
C CATEGORY:
C	ucsd/camera/for/lib
C CALLING SEQUENCE:
	subroutine smei_cal_write(bTestMode,bAppend,cFile,bTfloat,pattern_dark,pattern,nfrm,cfrm,TBeg,TEnd,ncr_count)
C INPUTS:
C	bTestMode	logical		.TRUE.: no Fits file created/modified
C					.FALSE.: Fits file created/modified
C	bAppend		logical		.FALSE.: create new Fits file
C					.TRUE. : append to existing Fits file
C	cFile*(*)	character	fully qualified name with type missing
C	bTfloat		logical		.TRUE. if pattern was based on frames near temperature
C					minimum (cam 1,2) or maximum (cam 3).
C	pattern_dark(2)	real		dark current in pattern (median and mean)
C	pattern(*)	real		engineering mode (1272x256) pattern array
C	nfrm		integer		# frames used to calculate the pattern
C	cfrm(nfrm)	character	names of frames used to calculate the pattern
C	TBeg(2)		integer		Begin time of closed shutter calibration data
C	TEnd(2)		integer		End time of closed shutter calibration data
C					All engineering mode frames between TBeg and TEnd
C					are used for the performance test.
C	ncr_count	integer		cosmic ray count (from href=smei_cal_add=)
C OUTPUTS:
C CALLS:
C	iSetFileSpec, iGetFileSpec, iFilePath, iGetLun, iFreeLun, WriteR4GRD
C	say_fts, Time2Str, Int2Str, Flt2Str, Say, itrim, iOSSpawnCmd
C	FTINIT, FTPKNS, FTPKYS, FTPKYE, FTPKYL, FTCRHD, FTPHPR, FTPPRE, FTCLOS
C	FTPKYJ, ArrR4Copy, ArrR4Mask, ArrR4Zero, BadR4, bOpenFile
C INCLUDE:
	include		'smei_frm_layout.h'
	include		'ftspar.h'
	include		'filparts.h'
	include		'openfile.h'
	include		'smei_cal_version.h'
C PROCEDURE:
C	How many bad values do we expect????
C MODIFICATION HISTORY:
C	JUN-2004, Paul Hick (UCSD/CASS)
C	FEB-2007, Paul Hick (UCSD/CASS)
C	    Added bAppend argument to be able to append patterns with
C	    "bad pixel" mask applied.
C	DEC-2007, Paul Hick (UCSD/CASS)
C	    Added DATE keyword with creation date for file
C	JAN-2008, Paul Hick (UCSD/CASS), v. 1.01
C	    Added keyword SMEI_CAL with software version number
C	JUN-2008, Paul Hick (UCSD/CASS), v. 1.02
C	    Added argument bTestMode
C	    Added keyword TIME (same time as in pattern name)
C	    Fixed bug: keyword NAME was not filled correctly.
C	JUL-2008, Paul Hick (UCSD/CASS; pphick@ucsd.edu), v. 1.03
C	    Added keyword DARK_AVE with the mean dark current
C	    (DARK_VAL contains the median)
C-
	    logical	bTestMode
	    logical	bAppend
	    character	cFile*(*)
	    logical	bTfloat
	    real	pattern_dark(2)
	    real	pattern(*)
	    integer	nfrm
	    character	cfrm(*)*(*)
	    integer	TBeg(2)
	    integer	TEnd(2)
	    integer	ncr_count

	character	cSay*14		/'smei_cal_write'/
	character	cSeverity	/'E'/

	real		pat_mode_0(SMEI__FRM_NX  , SMEI__FRM_NY  )
	real		pat_mode_1(SMEI__FRM_NX/2, SMEI__FRM_NY/2)
	real		pat_mode_2(SMEI__FRM_NX/4, SMEI__FRM_NY/4)

	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

	logical		bOpenFile
	integer		Flt2Str
	integer		Time2Str

	integer		time(2)
	character	cStr*(FIL__LENGTH)

	parameter	(NFRM_MAX = 15)
	character	cfrm_max(NFRM_MAX)*80

	bad = BadR4()

	if (nfrm .gt. NFRM_MAX) call Say(cSay,'E','NFRM_MAX','parameter too small')

	do i=1,nfrm
	    j = iSetFileSpec(cfrm(i))
	    j = iGetFileSpec(FIL__NAME,FIL__NAME,cfrm_max(i))
	end do

	! Replace bad values by zero

	call ArrR4Copy(SMEI__FRM_NPIX,pattern,pat_mode_0)
	call ArrR4Mask(SMEI__FRM_NPIX,pattern,bad,0.0,0.0,0.0,1.0,pat_mode_0)

	! Calculate Mode 1 pattern (normal mode for cam 3)

	ibin = 2

	do j=1,SMEI__FRM_NY/ibin
	    do i=1,SMEI__FRM_NX/ibin

		pat_mode_1(i,j) = 0.0
		icnt = 0

		i0 = (i-1)*ibin
		j0 = (j-1)*ibin

		do jj=j0+1,j0+ibin
		    do ii=i0+1,i0+ibin
			if (pat_mode_0(ii,jj) .ne. 0.0) then
			    pat_mode_1(i,j) = pat_mode_1(i,j)+pat_mode_0(ii,jj)
			    icnt = icnt+1
			end if
		    end do
		end do

		if (icnt .ne. 0) pat_mode_1(i,j) = pat_mode_1(i,j)/icnt

	    end do
	end do

	! Calculate Mode 2 (normal mode for cam 1 and cam 2)

	ibin = 4

	do j=1, SMEI__FRM_NY/ibin
	    do i=1,SMEI__FRM_NX/ibin

		pat_mode_2(i,j) = 0.0
		icnt = 0

		i0 = (i-1)*ibin
		j0 = (j-1)*ibin

		do jj=j0+1,j0+ibin
		    do ii=i0+1,i0+ibin
			if (pat_mode_0(ii,jj) .ne. 0.0) then
			    pat_mode_2(i,j) = pat_mode_2(i,j)+pat_mode_0(ii,jj)
			    icnt = icnt+1
			end if
		    end do
		end do

		if (icnt .ne. 0) pat_mode_2(i,j) = pat_mode_2(i,j)/icnt

	    end do
	end do

	if (bTestMode) return

	! Write FITS file

	iFile = itrim(cFile)

	iU = iGetLun(cFile)

	istat = 0	! Initialize to zero
			! Stays zero as long as there are no FITS errors
	cFile(iFile+1:) = '.fts.gz'

	if (bAppend) then

	    ! Unzip existing pattern file (can't open .gz file for writing)

	    cStr = cFile
	    if (iOSSpawnCmd('gunzip '//cStr,0) .ne. 1)
     &		call Say(cSay,'E','#'//cStr,'gunzip error')
	    cFile(iFile+1:) = '.fts'

	    ! Reopen Fits file

	    call FTNOPN(iU, cFile, FTS__WRITE, istat)
	    if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	    ! Move to the end of the file

	    call FTMAHD(iu, 3, hdutype, istat)
	    if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

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

	else! Open a new Fits file. This will fail if the Fits file exists already.

	    call FTINIT(iU, cFile, 1, istat)
	    if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	end if

	cStr = cFile
	call Say(cSay,'I','#'//cStr,'calibration pattern')

	! Write Mode 0 as primary data

	nAxes(1) = SMEI__FRM_NX
	nAxes(2) = SMEI__FRM_NY

	! Write Mode 0 header

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

	! Add to Mode 0 header

        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 = iSetFileSpec(cFile)				! Pattern name
	i = iGetFileSpec(FIL__NAME, FIL__NAME, cStr)

	call FTPKYS(iU, 'NAME', cStr(:i), 'Name of pattern', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)
							! Pattern time
	call FTPKYS(iU, 'TIME', cStr(7:i), 'Time of pattern', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	call FTPKYS(iU, 'IMG_TYPE', 'calframe', 'Image type', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	! Names of all frames used for pattern

	call FTPKNS(iU,'FRAME',1,nfrm,cfrm_max,'SMEI pattern frame&', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	! Begin and end time of 'closed shutter' data.

	i = Time2Str('SMEI',TBeg,cStr)
	call FTPKYS(iU, 'T_BEG', cStr(:i), 'Begin of closed shutter data', istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	i = Time2Str('SMEI',TEnd,cStr)
	call FTPKYS(iU, 'T_END' , cStr(:i), 'End of closed shutter data'  , istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	! Median dark current of pattern.

	call FTPKYE(iU ,'DARK_VAL', pattern_dark(1), 5, 'Dark current of pattern (median)', istat)  
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	! Mean dark current of pattern.

	call FTPKYE(iU ,'DARK_AVE', pattern_dark(2), 5, 'Dark current of pattern (mean)', istat)  
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	! CCD temperature floating or regulated?

	call FTPKYL(iU ,'CCD_TEMP', bTfloat, 'TRUE for floating CCD temperature', istat)  
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

	! Cosmic ray count

	call FTPKYJ(iU ,'N_CRAYS' , ncr_count, 'Cosmic ray count', istat)  
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)

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

	! Write Mode 0 pattern data

	call FTPPRE(iU, 0, 1, SMEI__FRM_NPIX, pat_mode_0, istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)



	! Write Mode 1 as first extension

	ibin = 2
	nAxes(1) = SMEI__FRM_NX/ibin
	nAxes(2) = SMEI__FRM_NY/ibin

	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 FTPPRE(iU, 0, 1, SMEI__FRM_NPIX/(ibin*ibin), pat_mode_1, istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)



	! Write Mode 2 as second extension

	ibin = 4
	nAxes(1) = SMEI__FRM_NX/ibin
	nAxes(2) = SMEI__FRM_NY/ibin

	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 FTPPRE(iU, 0, 1, SMEI__FRM_NPIX/(ibin*ibin), pat_mode_2, istat)
	if (istat .ne. 0) call say_fts(cSay,cSeverity,istat)


	! Close pattern fts file

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

	iU = iFreeLun(iU)

	if (bAppend) then

	    ! Gzip the pattern file again

	    cStr = cFile
	    if (iOSSpawnCmd('gzip '//cStr,0) .ne. 1)
     &		call Say(cSay,'E','#'//cStr,'gzip error')
	    cFile(iFile+1:) = '.fts.gz'

	end if

	return
	end