C+ C NAME: C smei_cal C PURPOSE: C Determines dark current pattern from weekly closed shutter calibrations. C CALLING SEQUENCE: program smei_cal C smei_cal [-overwrite -crx -stats -nic] C destination= camera= mode= C INPUTS: C SMEI frames from SMEI data base. C OUTPUTS: C The primary output file is a Fits file with name c#cal_YYYY_DOY_hhmmss C in the destination directory, where the date is taken from the middle C frame in the group used to calculate the pattern. C C The Fits file contains the mode 0, mode 1 and mode 2 pattern. The mode C 0 array is the primary array, with mode 1 and 2 as Fits extensions. C C If -stats is set then one line for each frame is written to file C c#cal_YYYY_DOY_hhmmss_stats.dat. C C If -overwrite is set then existing pattern files are overwritten. By default C no new patterns are created if the Fits pattern file already exists. C (the pattern is still calculated and is used to process the other keywords). C INCLUDE: include 'dirspec.h' include 'openfile.h' include 'filparts.h' include 'smei_frm_hdr.h' include 'smei_frm_layout.h' include 'smei_frm_basepar.h' include 'math.h' include 'smei_cal_version.h' C CALLS: C Say, bOpenFile, iFreeLun, WriteI4GRD, smei_Time2Split, iFilePath C iSearch, iSetFileSpec, iGetFileSpec, smei_frm_measle, BadI4 C smei_frm_base, smei_get_frame, smei_cal_build, smei_cal_write C smei_frm_stats, smei_foreign, smei_calgroup, Int2Str, Str2Str C Time2Str, BadR4, itrim, bWriteFrm, smei_frm_read, smei_frm_pickup C iHideLogical, iOSDeleteFile, ArrR4Mask, ArrR4SetMinMax C smei_frm_saturated, smei_frm_clean, smei_frm_mode C smei_frm_get, smei_frm_c3mask, ArrR4Constant C RESTRICTIONS: C The program has only been tested on Linux. To get it to work on C Windows probably some modifications are needed to the Windows C version of iSearch. C EXAMPLES: C Make pattern files for all patterns defined in $SMEIDB/cal/txt C and make Fits files. C C smei_cal $SMEIDB/cal/txt/*.txt C C To put Fits pattern files only in directory $SMEIDB/cal C C smei_cal $SMEIDB/cal/txt/*.txt -destination=$SMEIDB/cal C PROCEDURE: C The patterns produced are identical to the patterns produced by Andys C original program with two differences: C 1. For cameras 1 and 2 Andy did not fill the pattern in the pedestal columns C (13-16, 1269-1272); this version does. C Since for cameras 1 and 2 the pedestal pattern is never used the first C difference does not matter. Only for camera 3 is the pedestal pattern used. C 2. Andys program did not use the dark current pixels in the top row on the C right side (row 256, cols 1265-1268) to calculate the dark current, but C did fill in the pattern for three of these pixels (1265-1267). Only in C pixel (1268,256) was the pattern not calculated. This program throws C out all four pixels all the time, so there is no pattern for these pixels. C For use with mode 1 and 2 data the engineering (mode 0) pattern is C binned down by 2x2 and 4x4, respectively. In mode 1 the pattern C in dark current pixels ([629,128] and [630,128] ) will be different; C in mode 2 dark current pixel [317,64] will be different. C C After 2005 June 8 (Doy 159) 00:00:00 UT only the left side of the frame C (the underscan region) is used in the pedestal calculation for camera 3. C (At the end of this day Coriolis came on-line again after a month long C mishap with Windsat). This was done to reduce the effect of an increasing C left-right assymetry due to dark-current bleeding in the direction of the C readout and artificially increasing the overscan pedestal values. C MODIFICATION HISTORY: C APR-2004, Andrew Buffington (UCSD/CASS; abuffington@ucsd.edu) C Note that "headroom" and small-scale FF are turned OFF when C camera 3 in 1x1 mode as here... C Another consequence of this is that columns 21 and 1264 are C NOT stamped out as would be the case if the SSFF were imposed. C Thus these have a full amount of pedestal and dark current, C but only an unknown and variable-with-row fraction of sky C between 0.5 and unity. Yuck! C JUN-2004, Paul Hick (UCSD/CASS) C Substantial rewrite to allow direct processing from the SMEI data base. C FEB-2007, Paul Hick (UCSD/CASS) C Modified to take presence of "bad pixel" mask into account for camera 3. C For patterns during times when a "bad pixel" mask is into effect C the pattern Fits file now contains an additional three extensions C with the mask-adjusted pattern for mode 0,1 and 2 C (see href=smei_frm_c3mask=). C MAR-2007, Paul Hick (UCSD/CASS) C For camera 3 after 2005_159 the pedestal is now calculated from the C left side (underscan) pedestal columns only. C JUN-2007, Paul Hick (UCSD/CASS) C Recompiled after bugfix in smei_frm_read. The bug did not affect C the calibration patterns, so the recompile does not change anything. C JUN-2007, Paul Hick (UCSD/CASS) C For camera 2 after 2006_125 the pedestal is now calculated from the C left side (underscan) pedestal columns only. C DEC-2007, Paul Hick (UCSD/CASS) C Added some code to prefix directory names to SMEI frames processed C to make the patterns (uses input through keyword -source). C JUN-2008, Paul Hick (UCSD/CASS) C Added cmd line option -test (test mode: no files written) C JUL-2008, Paul Hick (UCSD/CASS) C Both mean-based and median-based dark current are now put C in the Fits header for the calibration pattern C (previously only the median was put in the Fits file) C OCT-2008, Paul Hick (UCSD/CASS) C Added new mask to smei_frm_c3mask_active. Fixed some bugs in C defining transitions between masks. C NOV-2008, Paul Hick (UCSD/CASS; pphick@ucsd.edu), V2.00 C Whenever some estimate for the pedestal is needed this C is now obtained by a call to function smei_frm_ped_mean. C This replaces hardcoded values in ped_mean_ref_cam (copied C to ped_aux(SMEI__PED_MEAN_REF)) and ped_init_cam (copied C to base_aux(SMEI__BAS_PED_INIT+[0,1,2]). C- character cSay*8 /'smei_cal'/ !=============== ! Function types integer Str2Str integer Time2Str integer BadI4 logical ForeignArgSet logical bOpenFile integer smei_frm_pickup logical smei_frm_base integer smei_frm_path integer smei_frm_mode integer smei_frm_saturated logical smei_frm_get logical smei_frm_read logical smei_frm_c3mask logical bWriteFrm integer smei_calgroup character cDbl2Str*14 !=============== character cStr *(FIL__LENGTH) character cFrmSpec*(FIL__LENGTH) character cFrmName*(FIL__LENGTH) character cBase *(FIL__LENGTH) character cDest *(FIL__LENGTH) character cListAll*(FIL__LENGTH) character cArg *(FIL__LENGTH) integer CAL__NLST_MAX parameter (CAL__NLST_MAX = 1000) ! Calibration definition files character cList(CAL__NLST_MAX)*(FIL__LENGTH) integer CAL__NFRM_MAX parameter (CAL__NFRM_MAX = 25) ! Individual "closed-shuttter" frames character cframe(CAL__NFRM_MAX)*(FIL__LENGTH) character cFrmRef*(FIL__LENGTH) real pattern (SMEI__FRM_NPIX) real pattern_dark_pixs(SMEI__DRK_NPIX) real pattern_dark(2) ! ccd_frame(1:SMEI__FRM_NPIX) ! original frame after processing by smei_frm_clean ! ccd_frame(SMEI__FRM_NPIX+1,2*SMEI__FRM_NPIX) ! frame after subtraction of pedestal and pattern before measle removal ! ccd_frame(2*SMEI__FRM_NPIX+1,3*SMEI__FRM_NPIX) ! frame after subtraction of pedestal and pattern after measle removal real ccd_frame (SMEI__FRM_NPIX*3) real rmask(SMEI__FRM_NPIX) integer imask(SMEI__FRM_NPIX) ! Scratch arrays equivalence (rmask,imask) integer indx(SMEI__FRM_NPIX) double precision hdr(SMEI__HDR_N) integer CAL__NDRK_MAX parameter (CAL__NDRK_MAX = 3001) ! Dark current pixs for first CAL__NDRK_MAX frames real dark_pixs(SMEI__DRK_NPIX, CAL__NDRK_MAX) !========================= ! In-/output arrays for smei_frm_ped, smei_frm_dark, smei_frm_base real ped_aux (SMEI__PED_NUM) real dark_aux(SMEI__DRK_NUM) real base_aux(SMEI__BAS_NUM) ! Control variables logical bStats logical bCRX logical bNic logical bOverwrite logical bWrite logical bQuiet logical bFrameOK logical bDig logical bMask logical bAppend logical bTestMode logical bTfloat integer iU_stat /FIL__NOUNIT/ integer TTime(2) integer TBeg (2) integer TEnd (2) !============================================================ ! Constraints on pedestal and dark current (camera dependent) ! For eng mode (no binning): 222.22 adu's = 1000 electrons ! ========================= ! Constants determining the pattern calculation. ! ! pattern_cut_cam: 0.5*patcr in Andy's programs ! Used in smei_cal_add to exclude pos and neg outlier pixels from ! contributing to the pattern (in Andy's programs the value ! used is twice as big, but is multiplied by 0.5 when the cut is applied). real pattern_cut_cam (3) / 22.22, 22.22, 22.22/ ! ped_mean_ref_cam: Andy's pedinit ! Reference pedestal used in smei_frm_ped in combination with ! ped_mean_excess_cam to detect 'crazy frames' with unrealistic high pedestal. !real ped_mean_ref_cam (3) / 996.0, 1013.0, 1046.0/! = ped_init_cam(1,*) ! ped_mean_excess_cam: hardcoded in Andy's programs ! Excess above naive mean pedestal used in smei_frm_ped to detect 'crazy ! frames' with unrealistic high pedestal. ! FEB-2007: Setting the mean excess to a really big value for camera 3 ! effectively disables the test. Since the frames for the pattern ! calculation are "hand-picked this should not be a problem. !real ped_mean_excess_cam (3) /3* 50.0/ real ped_mean_excess_cam (3) /2* 50.0, 5000.0/ ! ped_median_deficit_cam, ped_median_excess_cam ! Deficit and excess, respectively, relative to naive median, used in ! smei_frm_ped to exclude low and high outliers from contributing to the ! pedestal calculation. The deficit (set to MATH__NARN) is not applied here. real ped_median_deficit_cam (3) /3*MATH__NARN/ real ped_median_excess_cam (3) /3* 4.0/ !========================= ! Constants that do not affect the pattern calculation, ! and only affect the performance test. ! ped_init_cam(0,*) = Andys pedinit2 (slightly bigger than pedinit) ! ped_init_cam(1,*) = Andys pedinit ! Used to reinitialize ped_last in smei_frm_base after more than ! 12 rejected frames. ! ped_init_cam(2,*) = Andys pedinit (cam 1 and 2) or pedinit2 (cam 3) ! Used to initialize ped_last in smei_frm_base. !real ped_init_cam (0:2,3) /1000.0, 996.0, 996.0, !& 1020.0, 1013.0, 1013.0, !& 1049.0, 1046.0, 1049.0/ ! dark_cut_cam: Andys patcr. In Andys program for cam 3 patcr is multiplied ! by 2 when the cut is applied. This factor of two is absorbed here in the value ! for dark_cut_cam itself. ! Used in smei_frm_dark to exclude pixels from contributing to the ! calculated dark current once the pattern is known. real dark_cut_cam(3) / 44.44, 44.44, 88.88/ ! dark_power_cam: hardcoded in Andys programs. ! When the pattern is subtracted the dark current ratio of frame and pattern ! is scaled with this power. Note that this power is applied inconsistently: ! it is not used when pixels are excluded from the dark current calculation ! by applying dark_cut_cam. real dark_power_cam(3) / 1.5 , 1.5 , 1.0 / ! For camera 3 only, the pattern is used in the pedestal calculation to correct ! for a left/right asymmetry (see smei_frm_ped). real ped_right_offset_cam (3) /2*MATH__NARN, 0.0/ ! nped_min_cam, ndark_min_cam: hardcoded in Andys programs ! Threshold on minimum number of pixels required for validating a pedestal ! and dark current, respectively. integer nped_min_cam (3) /3*1800 / ! Indexed by camera, NOT mode integer ndark_min_cam(3) /1, 1, 684/ !========================== rbad = BadR4() ibad = BadI4() ! Pick up command line arguments call smei_foreign(1,cListAll,cBase,cDest,0,0,0,0.0d0,icam,mode,cArg) if (ForeignArgSet(cArg,'help')) then write (*,'(3X,A)') cSay, & ' '//'' , & ' '//cSwitch(:iSwitch)//'source=' , & ' '//cSwitch(:iSwitch)//'digsource' , & ' '//cSwitch(:iSwitch)//'destination=' , & ' '//cSwitch(:iSwitch)//'overwrite' , & ' '//cSwitch(:iSwitch)//'test' , & ' '//cSwitch(:iSwitch)//'stats' , & ' '//cSwitch(:iSwitch)//'crx' , & ' '//cSwitch(:iSwitch)//'nic' , & ' '//cSwitch(:iSwitch)//'quiet' , & ' '//cSwitch(:iSwitch)//'version' , & ' '//cSwitch(:iSwitch)//'dumpversion' call Say(cSay,'S','Stop','End syntax') end if if (ForeignArgSet(cArg,'dumpversion')) then ! Print version number write (*,'(F4.2)') version stop end if if (ForeignArgSet(cArg,'version')) ! Print version number & call Say(cSay,'S','Stop','Version '//cDbl2Str(version,2)// & 'Paul Hick (UCSD/CASS; pphick@ucsd.edu)') if (cDest .eq. ' ') i = iGetLogical('TUB',cDest) bDig = ForeignArgSet(cArg, 'digsource') bOverwrite = ForeignArgSet(cArg, 'overwrite') bStats = ForeignArgSet(cArg, 'stats' ) bCRX = ForeignArgSet(cArg, 'crx' ) bNic = ForeignArgSet(cArg, 'nic' ) bQuiet = ForeignArgSet(cArg, 'quiet' ) bTestMode = ForeignArgSet(cArg, 'test' ) call Say(cSay,'I','#'//cBase,'is input directory') if (bTestMode) then call Say(cSay,'I','#test mode: no files written') else call Say(cSay,'I','#'//cDest,'is output directory') end if ! Pick up all the ASCII pattern files matching cListAll nList = 0 iFind = 1 do while ( iSearch(iFind,cListAll,cStr) .eq. 1 ) iFind = 0 nList = nList+1 if (nList .gt. CAL__NLST_MAX) call Say(cSay,'E','Too','many patterns to process') cList(nList) = cStr end do i = 0 i = i+Int2Str(nList , cStr(i+1:)) i = i+Str2Str(' pattern(s)#.#.', cStr(i+1:)) call Say(cSay,'I','Process',cStr) do iList=1,nList ! Loop over all patterns !=========================================================== ! Get information on frames to be used for pattern calculation: ! camera, begin and end time of 'shutter closed' data, names of frames ! to be used for pattern calculation. ! cframe will only contain file names (no directory, no extension) nframe = smei_calgroup(cList(iList), icam, TBeg,TEnd, cframe, cStr, bTfloat) i = iFilePath(cDest,0,' ',cStr,cFrmRef) ! Translate cBase (=SMEIDB? or SMEIDC?) into a directory and prefix ! to cframe (note that cframe does not yet have a file extension. ! This is added by smei_frm_read). do i=1,nframe j = smei_frm_path(.TRUE., cframe(i), TTime, jcam, cBase, cStr) j = iFilePath(cStr, 0, '', cframe(i), cframe(i)) end do bWrite = bOverwrite if (bWrite) then ! Overwrite ! Delete existing .fts and .fts.gz files if they exist. ! (smei_cal_write will not overwrite existing Fits files). cStr = cFrmRef(:itrim(cFrmRef))//'.fts' if (iSearch(11, cStr, cStr) .eq. 1) i = iOSDeleteFile(cStr) cStr = cFrmRef(:itrim(cFrmRef))//'.fts.gz' if (iSearch(11, cStr, cStr) .eq. 1) i = iOSDeleteFile(cStr) else ! Don't overwrite cStr = cFrmRef(:itrim(cFrmRef))//'.fts' bWrite = iSearch(11, cStr, cStr) .ne. 1 if (bWrite) then cStr = cFrmRef(:itrim(cFrmRef))//'.fts.gz' bWrite = iSearch(11, cStr, cStr) .ne. 1 end if if (.not. bWrite .and. .not. bQuiet) call Say(cSay,'I','#'//cStr,'exists, so skip') end if if (bWrite .or. bStats) then ! Calculate pattern i = 0 i = i+Str2Str ('.#.#.#pattern calculation from closed shutter data#', cStr(i+1:)) i = i+Int2Str (nframe , cStr(i+1:)) i = i+Str2Str (' pattern frames in group', cStr(i+1:)) i = i+Str2Str ('#begin:' , cStr(i+1:))+1 i = i+Time2Str('SMEI (MN/DD)', TBeg , cStr(i+1:))+3 i = i+Str2Str ('end:' , cStr(i+1:))+1 i = i+Time2Str('SMEI (MN/DD)', TEnd , cStr(i+1:)) call Say(cSay,'I','next',cStr) !=========================================================== ! Pick up threshold for pedestal and dark current calculation ! Parameters for pedestal calculation !ped_aux(SMEI__PED_MEAN_REF ) = ped_mean_ref_cam (icam) ped_aux(SMEI__PED_MEAN_EXCESS ) = ped_mean_excess_cam (icam) ped_aux(SMEI__PED_MEDIAN_DEFICIT) = ped_median_deficit_cam(icam)! Set to bad: not used ped_aux(SMEI__PED_MEDIAN_EXCESS ) = ped_median_excess_cam (icam) ! Don't use the pattern in the pedestal calculation (don't have one yet). ped_aux(SMEI__PED_RIGHT_OFFSET ) = rbad ! After 2005, Doy 159 (camera 3 only) the pedestal is ! calculated only from the underscan region (left side of frame) call smei_Time2Split(1,cframe(1),TTime) i = Time2Str('YYYY_DOY_hhmmss',TTime,cStr) if (icam .eq. 3 .and. cStr(:i) .gt. SMEI__UT_C3_LEFT_SIDE_ONLY) then ped_aux(SMEI__PED_LEFT_SIDE_ONLY) = 0.0 call Say(cSay,'I','only','left side of frame used for pedestal') else ped_aux(SMEI__PED_LEFT_SIDE_ONLY) = rbad end if ! For camera 3 only the onboard mask may need to applied. ! For camera 1 and 2 the mask is set to one everywhere (not ! really necessary) bMask = icam .eq. 3 if (bMask) then bMask = smei_frm_c3mask(1,cStr,-1,rmask) if (bMask) call Say(cSay,'I','mask','patterns with "bad pixel" mask added') else call ArrR4Constant(SMEI__FRM_NPIX,1.0,rmask) end if !=========================================================== ! Pattern calculation from nframe frames with names cframe pattern_cut = pattern_cut_cam(icam) ! First calculate a pattern ignoring the onboard mask for cam 3 ! (in this case rmask is not used). call smei_cal_build(.FALSE.,rmask,nframe,cframe,cDest, & pattern_cut,pattern,pattern_dark,dark_pixs,ncr,ped_aux) if (bWrite) then ! Write pattern files bAppend = .FALSE. cStr = cFrmRef ! Don't feed cFrmRef directly; it might be modified call smei_cal_write(bTestMode,bAppend,cStr,bTFloat,pattern_dark,pattern,nframe,cframe,TBeg,TEnd,ncr) if (bMask) then ! bMask=.TRUE. happens only for camera 3. ! Calculate another calibration pattern but now with the ! onboard mask applied. call smei_cal_build(bMask,rmask,nframe,cframe,cDest, & pattern_cut,pattern,pattern_dark,dark_pixs,ncr,ped_aux) bAppend = .TRUE. cStr = cFrmRef ! Don't feed cFrmRef directly; it might be modified call smei_cal_write(bTestMode,bAppend,cStr,bTFloat,pattern_dark,pattern,nframe,cframe,TBeg,TEnd,ncr) end if end if end if !=========================================================== !=========================================================== if (bStats) then ! Get statistics for all 'closed shutter' frames call Say(cSay,'I','Start','.#.#.#processing shutter closed data') i = smei_frm_pickup(1,SMEI__FRM_NX,SMEI__FRM_NY,pattern,pattern_dark_pixs) ! Open the file to receive the time series over all frames ! for pedestal, dark current etc. (one line per frame). iU_stat = iFreeLun(iU_stat) ! Close previous file, if still open iRecl = 0 i = OPN__TEXT+OPN__TRYINPUT+OPN__UNKNOWN+OPN__ONEPASS+OPN__STOP cStr = cFrmRef(:itrim(cFrmRef))//'_stats.dat' if (.not. bOpenFile(I,iU_stat,cStr,iRecl)) stop nprint = 100 i = 0 i = i+Str2Str('first of every' , cStr(i+1:))+1 i = i+Int2Str(nprint , cStr(i+1:)) i = i+Str2Str(' frame names' , cStr(i+1:)) call Say(cSay,'I','printing',cStr) ! Use pattern for pedestal calculation (only camera 3) ped_aux (SMEI__PED_RIGHT_OFFSET ) = ped_right_offset_cam(icam) dark_aux(SMEI__DRK_CUT ) = dark_cut_cam(icam) dark_aux(SMEI__DRK_HEADROOM ) = 1.0 ! Also return arg in smei_frm_read base_aux(SMEI__BAS_NPED_MIN ) = nped_min_cam (icam) base_aux(SMEI__BAS_NDARK_MIN ) = ndark_min_cam(icam) !base_aux(SMEI__BAS_PED_INIT+0 ) = ped_init_cam(0,icam)! Andy's pedinit2 !base_aux(SMEI__BAS_PED_INIT+1 ) = ped_init_cam(1,icam)! Andy's pedinit !base_aux(SMEI__BAS_PED_INIT+2 ) = ped_init_cam(2,icam) base_aux(SMEI__BAS_PATTERN_DARK ) = pattern_dark(1) base_aux(SMEI__BAS_DARK_GUESS ) = pattern_dark(1) ! For first call to smei_frm_base base_aux(SMEI__BAS_NPED_BAD ) = -1 ! Used to intialize smei_frm_base iFirst = 1 do while (smei_frm_get(iFirst,TBeg,TEnd,icam,bDig,cBase,cFrmSpec)) bFrameOK = smei_frm_read(OPN__REOPEN+min(mod(nframe,nprint),1)*OPN__NOMESSAGE, & cFrmSpec, SMEI__FRM_NPIX, nx,ny,nb,ccd_frame,hdr,headroom) if (bFrameOK) then ! File read OK, check mode bFrameOK = smei_frm_mode(nx, nbin) .eq. 0 if (.not. bFrameOK) then i = iHideLogical(cFrmSpec,cStr) i = i+Str2Str('#not in engineering mode (mode 0)', cStr(i+1:)) call Say(cSay,'W','reject',cStr) end if end if if (bFrameOK) then ! Mode OK, get pedestal and dark current nframe = nframe+1 if (nframe .eq. CAL__NDRK_MAX) call Say(cSay,'W','CAL__NDRK_MAX', & '.#.#parameter too small; dark_pixs array is now full#.#.') i = smei_frm_clean(nx, ny, ccd_frame, ccd_frame) bFrameOK = smei_frm_base(cFrmSpec, nx, ny, ccd_frame, pattern, & nped, ped_val, ndark, dark_val, dark_pixs(1,min(nframe,CAL__NDRK_MAX)), & ped_aux, dark_aux, base_aux) end if if (bFrameOK) then ! Pedestal and dark current OK base_aux(SMEI__BAS_DARK_GUESS) = dark_val ! For next call to smei_frm_base dark_ratio = dark_val/pattern_dark(1) ! Dark current ratio used to scale pattern power = dark_power_cam(icam) ! Raise to power 1.5 for cam 1 and 2 if (power .ne. 1.0) dark_ratio = dark_ratio**power ! Subtract the scaled pattern ! For the frame data also subtract the pedestal (dark_pix already has pedestal removed) ! and make a second copy of the residual frame for processing by smei_frm_measle. if (nframe .lt. CAL__NDRK_MAX) then do i=1,SMEI__DRK_NPIX val = dark_pixs(i,nframe) if (val .ne. rbad) val = val-dark_ratio*pattern_dark_pixs(i) dark_pixs(i,nframe) = val end do end if n_ante = 0 +nx*ny ! Position of frame before measle removal n_post = n_ante+nx*ny ! Position of frame after measle removal ! The pattern also has non-zero values in the pedestal columns. ! We only want to subtract the pattern in the dark current and uncovered pixels ! (or at least not scale with the dark current). do n=1,nx*ny if (ccd_frame(n) .ne. rbad) then ccd_frame(n_ante+n) = ccd_frame(n)-ped_val ! Measles NOT removed i = mod(n-1,nx)+1 if (SMEI__DRK_COL(1) .le. i .and. i .le. SMEI__DRK_COL(SMEI__DRK_NCOL)) & ccd_frame(n_ante+n) = ccd_frame(n_ante+n)-dark_ratio*pattern(n) else ccd_frame(n_ante+n) = rbad end if ccd_frame(n_post+n) = ccd_frame(n_ante+n) ! Fed to smei_frm_measle end do ! smei_frm_measle only checks the uncovered pixels ! Find measles (.TRUE. in first argument sets measles to rbad) icam = 0 call smei_frm_measle(.TRUE., icam, nx, ny, ccd_frame(n_post+1), & npos_measles, nbig_measles, imask, indx) !=========================================================== ! The frame is now checked for measles using the pattern information ! returned from smei_cal_build. i = iSetFileSpec(cFrmSpec) i = iGetFileSpec(FIL__NAME,FIL__NAME,cFrmName) camtemp = sngl( hdr( SMEI__HDR_CCD_TEMP) ) if ( nint( hdr( SMEI__HDR_SHUTTER ) ) .eq. 1) & call Say(cSay,'W',cFrmName,'shutter open') ! smei_frm_stats only checks the uncovered pixels ! Measles removed successfully. Get some stats for residual frame. call smei_frm_stats(nx,ny,ccd_frame(n_post+1),pixsum,ipixsum,pixdif,ipixdif) ! Append to *_dark_pixs.grd file ! Output files for each frame if (bCRX) then ! Residue (frame-ped-dark) before and after measles removal i = iFilePath(cDest,0,' ',cFrmName, cStr) call WriteI4GRD(0,0, cStr(:i)//'crn.grd', nx, ny, ccd_frame(n_ante+1),ibad, & 0,nx,0,ny,-100,200, '(20F9.3)', .FALSE.) call WriteI4GRD(0,0, cStr(:I)//'crx.grd', nx, ny, ccd_frame(n_post+1),ibad, & 0,nx,0,ny,-100,200, '(20F9.3)', .FALSE.) end if if (bNic) then nb = -4 hdr( SMEI__HDR_BITPIX ) = nb*8 hdr( SMEI__HDR_PEDESTAL ) = ped_val hdr( SMEI__HDR_DARK_MEDIAN ) = dark_val hdr( SMEI__HDR_DARK_MEAN ) = dark_aux(SMEI__DRK_MEAN) hdr( SMEI__HDR_N_PEDESTAL_COUNT) = nped hdr( SMEI__HDR_N_DARK_CURRENT ) = ndark hdr( SMEI__HDR_N_POS_MEASLES ) = npos_measles hdr( SMEI__HDR_N_BIG_MEASLES ) = nbig_measles i = iFilePath(cDest,0,' ',cFrmName, cStr) if (.not. bWriteFrm(cStr(:i)//'crx.nic',cDest,nx,ny,nb,ccd_frame(1+2*nx*ny),hdr)) continue end if if (bStats) then ! Check for saturated pixels n = smei_frm_saturated(nx,ny,ccd_frame) call smei_Time2Split(0,cFrmName,TTime) i = Time2Str('"MN/DD/YY hh:mm:ss"',TTime, cStr) write (iU_stat,'(A,2X,2F10.3,I6,3F10.2,I7)') & cStr(:i),ped_val-smei_frm_ped_mean(cFrmName),dark_val,npos_measles, C & cStr(:i),ped_val-ped_init_cam(1,icam),dark_val,npos_measles, & pixsum,pixdif,exp((camtemp+40.0)/8.7),n end if end if !=========================================================== end do ! do while ( smei_get_frame ) nframe = min(nframe, CAL__NDRK_MAX) nped_bad = nint( base_aux(SMEI__BAS_NPED_BAD) ) nbase_bad = nint( base_aux(SMEI__BAS_NBAD ) ) i = 0 i = i+Int2Str(nped_bad , cStr(i+1:))+1 i = i+Str2Str('based on crazy pedestal#', cStr(i+1:)) i = i+Int2Str(nbase_bad , cStr(i+1:)) i = i+Str2Str('/' , cStr(i+1:)) i = i+Int2Str(nframe , cStr(i+1:))+1 i = i+Str2Str('pedestal/dark values' , cStr(i+1:)) call Say(cSay,'I','discarded',cStr) i = SMEI__DRK_NPIX*nframe call WhatIsR4(i,dark_pixs,'1') call ArrR4Mask(i,dark_pixs,rbad,0.0,0.0,0.0,1.0,dark_pixs) call ArrR4SetMinMax(i,dark_pixs,-99.99,999.99) cStr = cFrmRef(:itrim(cFrmRef))//'_dark_pixs.grd' call WriteI4GRD(0,0,cStr, SMEI__DRK_NPIX, nframe, dark_pixs,ibad, 0,nframe,0,SMEI__DRK_NPIX,-5,50, '(20F7.2)', .TRUE.) end if call Say(cSay,'I','#'//cFrmRef,'pattern finished') end do ! do while (.TRUE.) call Say(cSay,'I','STOP','All done !!!') end