C+ C NAME: C smei_orb C PURPOSE: C Determines minimum pattern for a reference orbit. C Then uses the miminimum pattern to create difference patterns for C all orbits in a specified period. C CALLING SEQUENCE: program smei_orb C INPUTS: C (SMEI frames from SMEI data base) C C Input from command line (see smei_foreign): C C min_orbit integer extracted from C minimum= or minimum= C orbit to be used for calculating the mimimum pattern C in smei_orb. C beg_orbit integer extracted from C start= or start= C The first orbit for which a difference orbital pattern C is calculated. C end_orbit integer extracted from C start= or start= C The first orbit for which a minimum orbital pattern C is calculated. C norbit integer extracted from C orbits= C Alternative to end_orbit: # orbits processed starting C at start_orbit. C fraction(2) real extracted from lowfraction=lowfraction and C highfraction=highfraction respectively C two fractions of one defining the part of the orbit C used for the orbital minimum and difference patterns. C if fraction(1) < fraction(2) then only the part of the C orbit with fraction(1) <= orbitfraction <= fraction(2) C is used. C if fraction(1) > fraction(2) then only the beginning part C of the orbit with orbitfraction < fraction(2) and the trailing C part with orbitfraction >= fraction(2) is used. C OUTPUTS: C One mimimum pattern, many difference patterns. C INCLUDE: include 'dirspec.h' include 'filparts.h' include 'openfile.h' include 'ftspar.h' include 'smei_frm_layout.h' include 'smei_frm_hdr.h' include 'smei_frm_hdrok.h' C CALLS: C ForeignArgSet, Int2Str, Dbl2Str, Str2Str, Time2Str, Say C itrim, smei_frm_get, smei_orbit_time2, iSetFileSpec, iGetFileSpec C smei_Time2Split, ArrR4Bad, ArrR4Constant, smei_frm_clean C smei_frm_ok, smei_hdr_str, smei_orb_min, smei_orb_diff C smei_frm_read, smei_foreign, smei_frm_mode, smei_orbit2 C smei_orb_write, BadI4, cDbl2Str, cInt2Str, cHideLogical C ArrI4Copy, say_fts, smei_cal_get, smei_cal_init, ArrR4Copy C smei_frm_c3mask_active C PROCEDURE: C Fractions for May 2003: 0.5682, 0.1857 C Fractions for Oct 2003: 0.8694, 0.6398 (1325.0/1524, 975.0/1524) C EXAMPLE: C smei_orb -min=2035 -start=2035 -stop=2221 -destination=$TUB C -lowfraction=0.5682 -highfraction=0.1857 C MODIFICATION HISTORY: C MAR-2004, Andrew Buffington (UCSD/CASS; abuffington@ucsd.edu) C Note that "headroom" and small-scale FF are turned OFF when C camera 3 in 2x2 mode as here. Another consequence of this is C that columns 11 and 631 are NOT half stamped out as would be C the case if the SSFF were imposed. Thus these have a full C amount of pedestal and dark current, but only an unknown and C variable-with-row fraction of sky between 0.5 and unity. Yuck! C AUG-2004, Paul Hick (UCSD/CASS) C Rewrite based on Andys pattern_get_cam3.for C AUG-2005, Paul Hick (UCSD/CASS); V1.01 C Added code to update Fits header of individual frames with C name of difference pattern (the program version number is C coded into the comment string. C Added extra map to each orbital file containing for each pixel C the orbital fraction of the frame used to fill it. C JUL-2006, Paul Hick (UCSD/CASS); V3.01 C Added Fits keywords SMEI_ORB and CREATED to output files. C MAR-2007, Paul Hick (UCSD/CASS); V4.00 C Modified to cope with "bad pixel" masks. C The first frame of an orbit now sets both the name of the C "closed shutter" pattern and the flag that decides whether C or not a "bad pixel" mask is in effect. C JUN-2007, Paul Hick (UCSD/CASS); V4.10 C Fixed bug in smei_frm_read, introduced in V4.00 C The orbital pattern would have been wrong for orbits with C flat_enabled=0 during periods when a "bad-pixel" mask was C onboard. The first time this happens is after 2007_133. C Since these orbits have not been run yet, no harm done. C SEP-2008, Paul Hick (UCSD/CASS); V4.12 C Added command line argument sdark, and added call to C smei_frm_read_set_sdark. C OCT-2008, Paul Hick (UCSD/CASS; pphick@ucsd.edu); V4.13 C Modications to smei_frm_c3mask_active in handling C transitions between mask. Added new mask C- character cSay*3 /'orb'/ character cSeverity /'E'/ double precision version /4.13d0/ real ccd_frame (SMEI__FRM_NPIX) ! Read frame with smei_frm_read real cal_pattern (SMEI__FRM_NPIX) ! Closed-shutter calibration pattern real pattern (SMEI__FRM_NPIX*4) ! Orbital patterns parameter (i_min = 1) ! Used to place patterns in array. parameter (i_orbit = 2) parameter (i_diff = 3) parameter (i_frac = 4) ! === Functions logical ForeignArgSet logical smei_frm_read logical smei_frm_read_set_sdark logical smei_frm_ok logical smei_frm_get integer BadI4 integer Dbl2Str integer Str2Str integer Time2Str character cDbl2Str*14 integer smei_frm_mode integer smei_frm_c3mask_active character cInt2Str*14 character cHideLogical*(FIL__LENGTH) !==== character cArg *(FIL__LENGTH) character cFile *(FIL__LENGTH) character cBase *(FIL__LENGTH) character cDest *(FIL__LENGTH) character cStr *512 character cRefCal*21 /' '/ character cNewCal*21 character cOrbPat*21 /' '/ double precision hdr (SMEI__HDR_N) double precision hdrok(SMEI__HDROK_N) integer TMinBeg (2) integer TMinEnd (2) integer TBeg (2) integer TEnd (2) integer TLow (2) integer THigh (2) integer TFirst (2) integer TLast (2) integer tt1 (2) integer tt2 (2) integer beg_orbit integer end_orbit integer prev_orbit double precision forbit(2) integer orbit_time(2) double precision orbit_fraction integer orbit_number integer nframe(2) integer nframe_min /10/ !defines a minimum deviation for a pixel (one of eight) to be a discrepant neighbor real dev_cut /10.0/ ! Passed to smei_orb_diff logical bDig logical bUpdate logical bOverwrite logical bFrameOK logical bSilent logical bNewCal double precision cal_version integer c3mask /0/ integer ORB__NMAX_FRM parameter (ORB__NMAX_FRM = 1600) character cframe(ORB__NMAX_FRM)*(FIL__LENGTH) integer ORB__IACTNIC parameter (ORB__IACTNIC = OPN__REOPEN+OPN__STOP) integer ORB__NPRINT parameter (ORB__NPRINT = 100) ! Display once every ORB__NPRINT frames ! Process command line arguments call smei_foreign(2,cFile,cBase,cDest,TMinBeg,TBeg,TEnd,forbit,icam,mode,cArg) if (ForeignArgSet(cArg,'help')) then write (*,'(3X,A,T38,A)') cSay,' ', & ' '//cSwitch(:iSwitch)//'start_time=' ,' ', & ' '//cSwitch(:iSwitch)//'stop_time=' ,' ', & ' '//cSwitch(:iSwitch)//'camera=<1,2,3>' ,'default: 3', & ' '//cSwitch(:iSwitch)//'mode=<0,1,2>' ,'default: 2 for cam 1,2; 1 for cam 3', & ' '//cSwitch(:iSwitch)//'source=' ,'default: SMEIDB?', & ' '//cSwitch(:iSwitch)//'digsource' ,'default: off (on for SMEIDB?)', & ' '//cSwitch(:iSwitch)//'destination=' ,'default: $TUB', & ' '//cSwitch(:iSwitch)//'overwrite' ,'overwrite patterns; default: off', & ' '//cSwitch(:iSwitch)//'update' ,'update SMEI frames; default: off', & ' '//cSwitch(:iSwitch)//'sdark=<3,10>' ,'use 3/10-min-average dark current', & ' '//cSwitch(:iSwitch)//'grd' ,'default: off', & ' '//cSwitch(:iSwitch)//'quiet' ,'default: off', & ' '//cSwitch(:iSwitch)//'version' ,'print version number', & ' '//cSwitch(:iSwitch)//'dumpversion' ,'print version number' 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)') bDig = ForeignArgSet(cArg,'digsource') bOverwrite = ForeignArgSet(cArg,'overwrite') bUpdate = ForeignArgSet(cArg,'update') bSilent = ForeignArgSet(cArg,'quiet' ) ! smei_frm_read_set_sdark signal smei_frm_read which dark current ! to pull out of the file and put into the header call ForeignI4Arg(cArg,'sdark',-1,idark ) if (.not. smei_frm_read_set_sdark(idark)) & call Say(cSay,'E','sdark','funny setting for sdark keyword') i = BadI4() if (icam .eq. i) then icam = 3 if (mode .eq. i) mode = 1 end if if (icam .ne. 3) & call Say(cSay,'E','invalid','camera; only camera 3 is processed') if (mode .ne. 1) & call Say(cSay,'E','invalid','mode; only mode 1 (2x2) is processed') if (TMinBeg(1) .eq. i .or. TBeg(1) .eq. i .or. TEnd(1) .eq. i) & call Say(cSay,'E','orbits','no minimum, start or end orbit specified') ! Start and end time of orbit used to get minimum pattern. ! TMinBeg corresponds to min_orbit+0.0d0 ! TMinEnd corresponds to min_orbit+1.0d0 call smei_orbit2(TMinBeg,min_orbit,orbit_fraction) min_orbit = nint(min_orbit+orbit_fraction) call smei_orbit_time2(min_orbit+1,0.0d0,TMinEnd) ! Start time of first and last orbit used to get difference pattern ! TBeg corresponds to beg_orbit+0.0d0 ! TEnd corresponds to end_orbit+0.0d0 call smei_orbit2(TBeg,beg_orbit,orbit_fraction) beg_orbit = nint(beg_orbit+orbit_fraction) call smei_orbit2(TEnd,end_orbit,orbit_fraction) end_orbit = nint(end_orbit+orbit_fraction) i = 0 i = i+Str2Str('#.#camera' , cStr(i+1:))+1 i = i+Int2Str(icam , cStr(i+1:)) i = i+Str2Str(', mode' , cStr(i+1:))+1 i = i+Int2Str(mode , cStr(i+1:)) i = i+Str2Str('#.#' , cStr(i+1:)) i = i+Str2Str('minimum orbit is' , cStr(i+1:))+1 i = i+Int2Str(min_orbit , cStr(i+1:)) i = i+Str2Str('#' , cStr(i+1:)) i = i+Str2Str('covers' , cStr(i+1:))+1 i = i+Time2Str(SMEI__UT_FORMAT,TMinBeg , cStr(i+1:)) i = i+Str2Str(' -' , cStr(i+1:))+1 i = i+Time2Str(SMEI__UT_FORMAT,TMinEnd , cStr(i+1:)) i = i+Str2Str('#' , cStr(i+1:)) i = i+Str2Str('difference orbits' ,cStr(i+1:))+1 i = i+Int2Str(beg_orbit , cStr(i+1:)) i = i+Str2Str(' through' , cStr(i+1:))+1 i = i+Int2Str(end_orbit , cStr(i+1:)) i = i+Str2Str('#' , cStr(i+1:)) i = i+Str2Str('cover' , cStr(i+1:))+2 i = i+Time2Str(SMEI__UT_FORMAT,TBeg , cStr(i+1:)) i = i+Str2Str(' -' , cStr(i+1:))+1 i = i+Time2Str(SMEI__UT_FORMAT,TEnd , cStr(i+1:)) i = i+Str2Str('#orbit section' , cStr(i+1:))+1 i = i+Dbl2Str(forbit(1) , 2 , cStr(i+1:)) i = i+Str2Str(' to' , cStr(i+1:))+1 i = i+Dbl2Str(forbit(2) , 2 , cStr(i+1:)) i = i+Str2Str('#read frames from '//cHideLogical(cBase),cStr(i+1:)) if (bDig ) i = i+Str2Str(' (digging)',cStr(i+1:)) if (bUpdate) i = i+Str2Str(' (update)', cStr(i+1:)) i = i+Str2Str('#write patterns to '//cHideLogical(cDest),cStr(i+1:)) if (bOverwrite) i = i+Str2Str(' (overwrite)', cStr(i+1:)) call Say(cSay,'I','orbits',cStr) !================================================ ! MIMIMUM PATTERN DETERMINATION FOR REFERENCE ORBIT ! (USUALLY FIRST COMPLETE ORBIT AFTER "SHUTTER CLOSE" CALIBRATION) i = 0 i = i+Time2Str(SMEI__UT_FORMAT,TMinBeg , cStr(i+1:)) i = i+Str2Str (' -' , cStr(i+1:))+1 i = i+Time2Str(SMEI__UT_FORMAT,TMinEnd , cStr(i+1:)) call Say(cSay,'I','min orbit '//cInt2Str(min_orbit),cStr) nframe(1) = 0 ! Counts all frames in minimum orbit nframe(2) = 0 ! Counts frames in fraction of minimum orbit used to make min pattern call smei_orbit_time2(min_orbit,forbit(1),TLow ) call smei_orbit_time2(min_orbit,forbit(2),THigh) call smei_cal_init() ! MUST stay before first smei_frm_get call iFirst = 1 bFrameOK = smei_frm_get(iFirst,TMinBeg,TMinEnd,icam,mode,bDig,cBase,cFile) ! The very first frame after TMinBeg is read to set the "shutter-closed" ! calibration pattern and the "bad pixel" mask flag. ! All subsequent frames must have the same calibration pattern in the header. if (bFrameOK) then if (.not. smei_frm_read(ORB__IACTNIC,cFile,SMEI__FRM_NPIX,nx,ny,nb,ccd_frame,hdr,headroom)) & call Say(cSay,'E','#'//cFile,'read error on first frame') ! Time of 1st frame into orbit for minimum pattern call smei_Time2Split(1,cFile,TFirst) ! Pick up name of "closed shutter" pattern call smei_hdr_str(SMEI__HDR_CAL_PATTERN, hdr, cRefCal) ! Pick up value of "bad pixel mask active" flag i = Time2Str(SMEI__UT_FORMAT,TFirst,cStr) c3mask = smei_frm_c3mask_active(0,cStr(:i), & nint(hdr(SMEI__HDR_FLAT_ENABLED)),cStr,fudge) ! Read pattern with "bad pixel" mask applied (c3mask=1) or not (c3mask=0) call smei_cal_get(cRefCal,0,icam,mode,c3mask,TMinBeg,cStr,cal_pattern,pattern_dark,bNewCal,cal_version) ntot = nx*ny ! Total number of pixels ip_min = (i_min -1)*ntot ! ip_* vars are used to index array pattern. ip_orbit = (i_orbit-1)*ntot ip_diff = (i_diff -1)*ntot ip_frac = (i_frac -1)*ntot call ArrR4Bad (ntot, pattern(ip_min +1)) ! Clear mimimum pattern call ArrR4Constant(ntot, -1.0, pattern(ip_frac+1)) end if do while (bFrameOK) ! Loop over frames between TMinBeg and TMinEnd nframe(1) = nframe(1)+1 ! Count frames in orbit ! Make sure to include only frames between forbit(1) and forbit(2) call smei_Time2Split(1,cFile,orbit_time) call ArrR4Copy(2,orbit_time,TLast) call smei_orbit2(orbit_time,orbit_number,orbit_fraction) bFrameOK = (forbit(2) .ge. forbit(1) .and. (forbit(1) .le. orbit_fraction .and. orbit_fraction .le. forbit(2))) & .or. (forbit(2) .lt. forbit(1) .and. (orbit_fraction .le. forbit(2) .or. orbit_fraction .ge. forbit(1))) if (bFrameOK) then iAct = ORB__IACTNIC+min(mod(nframe(1),ORB__NPRINT),1)*OPN__NOMESSAGE bFrameOK = smei_frm_read(iAct,cFile,SMEI__FRM_NPIX,nx,ny,nb,ccd_frame,hdr,headroom) end if if (bFrameOK) then ! Read OK: check mode and calibration pattern ! All frames must have the same mode. i = smei_frm_mode(nx,nbin) if (i .ne. mode) call Say(cSay,'W','#'//cFile, 'wrong or invalid mode '//cInt2Str(i)) ! All frames must have the same calibration pattern call smei_hdr_str(SMEI__HDR_CAL_PATTERN, hdr, cNewCal) if (cNewCal .ne. cRefCal) & call Say(cSay,'E','#'//cFile, cNewCal//' is not reference cal '//cRefCal) ! All frames must have the C3 mask flag off or on i = Time2Str(SMEI__UT_FORMAT,orbit_time,cStr) i = smei_frm_c3mask_active(0,cStr(:i), & nint(hdr(SMEI__HDR_FLAT_ENABLED)),cStr,fudge) if (i .ne. c3mask) & call Say(cSay,'E','#'//cFile, 'unexpected "bad pixel" mask change') i = iSetFileSpec(cFile) i = iGetFileSpec(FIL__NAME,FIL__NAME,cStr) bFrameOK = smei_frm_ok(cArg,cStr,hdr,hdrok,bSilent) end if if (bFrameOK) then ped_val = sngl( hdr(SMEI__HDR_PEDESTAL ) ) dark_val = sngl( hdr(SMEI__HDR_DARK_MEDIAN) ) nframe(2) = nframe(2)+1 ! Number of seconds since start of orbit. ! (more precisely: number of seconds since first frame in orbit) nsec = (orbit_time(1)-TFirst(1))*86400+(orbit_time(2)-TFirst(2))/1000 i = smei_frm_clean(nx,ny,ccd_frame,ccd_frame) call smei_orb_min(nsec,nx,ny,ccd_frame,ip_min,ip_frac,pattern,ped_val,dark_val/pattern_dark,cal_pattern) end if bFrameOK = smei_frm_get(iFirst,TMinBeg,TMinEnd,icam,mode,bDig,cBase,cFile) end do i = 0 i = i+Str2Str('pattern based on', cStr(i+1:))+1 i = i+Int2Str(nframe(2) , cStr(i+1:)) i = i+Str2Str('/' , cStr(i+1:)) i = i+Int2Str(nframe(1) , cStr(i+1:))+1 i = i+Str2Str('frames' , cStr(i+1:)) if (nframe(2) .lt. nframe_min) call Say(cSay, 'E', 'Min '//cInt2Str(min_orbit), cStr) call Say(cSay, 'I', 'Min '//cInt2Str(min_orbit), cStr) ! Write the minimum pattern for the first orbit call smei_orb_write(version,bOverwrite,.FALSE.,cDest,cRefCal,min_orbit,min_orbit, & TFirst,TLast,TLow,THigh,nframe,nx,ny,ip_min,ip_frac,pattern,cStr) !====================================================================== ! DIFFERENCE PATTERN DETERMINATION FOR ALL ORBITS BETWEEN TBeg AND TEnd iFirst = 1 bFrameOK = smei_frm_get(iFirst,TBeg,TEnd,icam,mode,bDig,cBase,cFile) do while (bFrameOK) ! Look for 1st frame in beg_orbit call smei_Time2Split(1,cFile,tt1) call smei_orbit2(tt1,orbit_number,orbit_fraction) bFrameOK = orbit_number .lt. beg_orbit if (bFrameOK) bFrameOK = smei_frm_get(iFirst,TBeg,TEnd,icam,mode,bDig,cBase,cFile) end do bFrameOK = itrim(cFile) .ne. 0 ! If bFrameOK=.TRUE. we found the first frame in orbit beg_orbit orbit_number = beg_orbit-1 ! Forces new orbit below nframe(1) = 0 ! Safety belt nframe(2) = 0 ! Safety belt do while (.TRUE.) prev_orbit = orbit_number if (bFrameOK) then call smei_Time2Split(1,cFile,orbit_time) ! Orbit time for current frame call smei_orbit2(orbit_time,orbit_number,orbit_fraction) else orbit_number = orbit_number+1 orbit_fraction = 0.0d0 end if if (orbit_number .gt. prev_orbit) then ! Start a new orbit ! (always if bFrameOK=.FALSE.) if (orbit_number .ne. beg_orbit) then ! Write difference pattern for previous orbit i = 0 i = i+Str2Str('pattern based on', cStr(i+1:))+1 i = i+Int2Str(nframe(2) , cStr(i+1:)) i = i+Str2Str('/' , cStr(i+1:)) i = i+Int2Str(nframe(1) , cStr(i+1:))+1 i = i+Str2Str('frames' , cStr(i+1:)) if (nframe(2) .lt. nframe_min) then call Say(cSay,'W','skip '//cInt2Str(prev_orbit),cStr) else call Say(cSay,'I','write '//cInt2Str(prev_orbit),cStr) call smei_orb_diff(nx, ny, i_min, i_orbit, i_diff, pattern, dev_cut, icount) call smei_orb_write(version,bOverwrite,.TRUE.,cDest,cRefCal,min_orbit,prev_orbit, & TFirst,TLast,TLow,THigh,nframe,nx,ny,ip_diff,ip_frac,pattern,cOrbPat) ! Update frame headers in whole orbit with name of difference pattern if (bUpdate) then call Say(cSay,'I','update','SMEI frames for orbit '//cInt2Str(prev_orbit)) iOrbPat = itrim(cOrbPat) do i=1,nframe(1) cStr = cframe(i) if (iOSSpawnCmd('gunzip '//cStr,0) .eq. 0) & call Say(cSay,'E','#'//cStr,'gunzip failed') iStr = itrim(cStr)-len('.gz') iU = iGetLun(cStr(:iStr)) istat = 0 call FTNOPN(iU, cStr(:iStr), FTS__WRITE, istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) ! Update name of orbital difference pattern. call FTUKYS(iU ,'ORB_PATT', cOrbPat(:iOrbPat), & 'on-the-fly orbital pattern, V'//cDbl2Str(version,2), istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTCLOS(iU, istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) iU = iFreeLun(iU) if (iOSSpawnCmd('gzip '//cStr(:iStr),0) .eq. 0) & call Say(cSay,'E','#'//cStr(:iStr),'gzip failed') end do end if end if end if if (.not. bFrameOK) call Say(cSay,'S','Stop', 'Done') nframe(1) = 0 nframe(2) = 0 call ArrI4Copy(2,orbit_time,TFirst) ! First frame in orbit 'orbit_number' call smei_orbit_time2(orbit_number,forbit(1),TLow ) call smei_orbit_time2(orbit_number,forbit(2),THigh) call smei_orbit_time2(orbit_number ,0.0d0,tt1) call smei_orbit_time2(orbit_number+1,0.0d0,tt2) i = 0 i = i+Time2Str(SMEI__UT_FORMAT,tt1, cStr(i+1:)) i = i+Str2Str(' -' , cStr(i+1:))+1 i = i+Time2Str(SMEI__UT_FORMAT,tt2, cStr(i+1:)) call Say(cSay,'I','orbit '//cInt2Str(orbit_number),cStr) call ArrR4Bad (ntot, pattern(ip_orbit+1)) ! Clear minimum pattern for this orbit call ArrR4Constant(ntot, -1.0, pattern(ip_frac +1)) end if ! Here bail out (don't even read the frame) if orbital position is known ! to lie within bad sun ! A cut on grittinexx at 40 was imposed when forming the "min" arrays: ! this here is at 866 ! The corresponding min value for avg response is 690, both on the trailing ! edge after a sun transit !if (k .gt. 2 .and. iarg .ge. 283 .and. iarg .le. 866) then !bail out !ibadorbit=ibadorbit+1 !go to 98 !end if nframe(1) = nframe(1)+1 if (nframe(1) .gt. ORB__NMAX_FRM) call Say(cSay,'E','ORB__NMAX_FRM','parameter too small') cframe(nframe(1)) = cFile ! Make sure to include only frames between forbit(1) and forbit(2) call ArrR4Copy(2,orbit_time,TLast) bFrameOK = (forbit(2) .ge. forbit(1) .and. (forbit(1) .le. orbit_fraction .and. orbit_fraction .le. forbit(2))) & .or. (forbit(2) .lt. forbit(1) .and. (orbit_fraction .le. forbit(2) .or. orbit_fraction .ge. forbit(1))) if (bFrameOK) then iAct = ORB__IACTNIC+min(mod(nframe(2),ORB__NPRINT),1)*OPN__NOMESSAGE bFrameOK = smei_frm_read(iAct,cFile,SMEI__FRM_NPIX,nx,ny,nb,ccd_frame,hdr,headroom) end if if (bFrameOK) then i = smei_frm_mode(nx,nbin) if (i .ne. mode) call Say(cSay,'W','#'//cFile, 'wrong or invalid mode '//cInt2Str(i)) call smei_hdr_str(SMEI__HDR_CAL_PATTERN, hdr, cNewCal) if (cNewCal .ne. cRefCal) & call Say(cSay,'E','#'//cFile, cNewCal//' is not reference cal '//cRefCal) i = iSetFileSpec(cFile) i = iGetFileSpec(FIL__NAME,FIL__NAME,cStr) bFrameOK = smei_frm_ok(cArg,cStr,hdr,hdrok,bSilent) end if if (bFrameOK) then ped_val = sngl( hdr(SMEI__HDR_PEDESTAL ) ) dark_val = sngl( hdr(SMEI__HDR_DARK_MEDIAN) ) nframe(2) = nframe(2)+1 ! Number of seconds since start of orbit. ! (more precisely: number of seconds since first frame in orbit) nsec = (orbit_time(1)-TFirst(1))*86400+(orbit_time(2)-TFirst(2))/1000 i = smei_frm_clean(nx,ny,ccd_frame,ccd_frame) call smei_orb_min(nsec,nx,ny,ccd_frame,ip_orbit,ip_frac,pattern,ped_val,dark_val/pattern_dark,cal_pattern) end if ! Get name of next frame to process bFrameOK = smei_frm_get(iFirst,TBeg,TEnd,icam,mode,bDig,cBase,cFile) end do end