c Maxim Markevitch <maxim % head.cfa.harvard.edu>, last update 14 Aug 07

c 14.8.7: emandel changed 0->0.0 in all write statements for compiler
c 24.3.7: av added istat=0
c 1.2.7: emandel fixed syntax, mm fixed format error, to run on f95
c 30.1.7: string lengths from 128 to 512 (also in get_param.c)
c emandel removed commas from read() for compatib.
c 6.10.5: instead of rejecting bins with >2% gti gaps, include all bins
c         with more than okfrac=90% of good time (correcting tbin for okfrac),
c         even those with one bound outside of gti, which were 
c         automatically excluded before.
c 5.10.5: 1. select tstart as max(header,gti,1stevt); was from header
c         2. check for gti gaps inside each lc bin; if >okfrac, exclude bin
c         3. if both ends of bin are outside gti, look for narrow gti fully 
c            enclosed, exclude if present
c         4. instead of excluding gtis<tbin, for each excluded lc bin reset
c            any inside gti bounds to the bin bounds, and then exclude only
c            gtis<1s. This saves good bins containing narrow gti gaps
c            which follow an excluded bin.
c         5. manually exclude gtis prior to tstart (G. Sivakoff)
c 4.10.5: filter by ratio of rates in 2 energy bands (par. fileref*);
c         print more decimal places;
c         added write_separate_chips par (instead of always writing sep. chips)
c 23.10.3: check par. ignore_neg_devs in addition to ignore_neg_dev
c   removed commas in write(), to compile by intel fortran
c 30.5.3: increased maxev to 4e6
c 12.7.2: added ignore_neg_dev (default not ignore, exclude from gti),
c  ignore_spikes now only applies to positive deviations.
c 3.4.2: fixed writing of individ. chip's light curves (was writing rlight
c  instead of rlchip)
c 24.2.2: tbin -> r*8 ttbin; compare gtis with 0.999*ttbin to avoid num
c  problem; fixed missing 1st and last lc bins when writing histogr.
c 11.12.1: note that maxgti here and in if_goodttime are different
c  (no changes in this file)
c 3.10.1: in write_gti, replaced ftcopy with ftcphd (no longer copy the data
c   from input gti and overwrite it); now update checksums. added summing of
c   narrow and bin boundary gtis; changed some printout.
c 1.8.1:  added error diagn. printout, renamed tbeg -> tstart for clarity
c 27.6.1: initialize istat=0, because g77 doesn't. 
c 6.2.1:  parameter write_table_lc; print how much zero-rate time excluded;
c   calc and writing now use (mink,maxk) index interval instead of (0,maxlc)
c 31.1.1: take care of ext# in input gti file, if given (in if_goodttime.f and
c   sub write_gti below)
c 26.10.00: fixed minor bugs: exclude from the final GTI the lc bins sitting on
c   the boundaries of the original GTIs (added -2 flag to rlight);
c   fixed writing GTI in ascii format (iout_gti was undefined);
c   changeg output format for times and rates to f*.3
c 7.7.00: changed int itime to real*8 ttime, tbeg -> real*8 ttbeg,
c   itbin -> tbin; igti to real*8 ggti; if_goodtime to real*8 version
c   if_goodttime; read_gti to real*8 ver. read_ggti; sort -> ssort, i t.p.
c 15.3.00: now takes par file name from command line; says if cannot open it.
c 20.10.99: now outputs count rate after cleaning.
c 20.8.99: many changes to user interface.
c   clean_lc -> lc_clean (adopt for ACIS); changed num of chips from 0:3 (SIS)
c   to 0:9.

c clean_lc for ASCA:
c 23.12.97: changed printout when asking for tbeg
c 7.7.97 (v2): changed lc creation algorithm to use nonchronologic input
c files; added parameters tbeg, ignore_nodata and ignore_spikes
c 14.5.97 (v1.4): output uncleaned light curves for individual sis chips, to
c check for saturation. also, replace ? in the output filenames by s0, g2 etc.

      parameter (maxev=4 000 000, maxlc=50 000, maxgti=2048, clip0=3.,
     ~    okfrac=0.9)
      character*1 pfile*512, pname*512, val*512, a80*80, a30*30, fname*512,
     ~    a1*1,a2*2,a8*8, accd(maxev)
      integer lnblnk
      real rlight(0:maxlc,2), rlchip(0:maxlc,0:9)
      real*8 mmean, mmean2, ttime(maxev),tt,tt0,ttz, ggti(maxgti,2),
     ~    jjunk1(maxgti), jjunk2(maxgti), ttbin, ttb,tte,
     ~    ttstart, ttstartgti, ttstarthead, ttstartevt
      logical anyf, was_fits, if_goodttime, have_tstart,
     ~    ignore_nodata, ignore_spikes, ignore_neg_dev,
     ~    acis, chips(0:9),
     ~    filt_sigma, filt_factor, force_mean, write_table_lc, filt_ratio,
     ~    write_separate_chips, tstart_undecided, use_gtistart
      data chips /10*.false./
      common /parf/ pfile
      istat=0

      print*
      print'(" This is lc_clean v140807")'
      print*


c get name of par file from command line, if supplied:
      call getarg (1,pfile)

*      print*,"_",lnblnk(pfile),"_"
* check lnblnk on intel

      if (pfile(1:1).eq."@") then
c cut AV's leading @:
        pfile=pfile(2:lnblnk(pfile))
      end if
      if (pfile.eq."") then
        pfile="lc_clean.par"
      end if 


c read parameters:

c how many data files:
      pname="num_datafiles "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.255) then
        print'(" Cannot open or read parameter file.")'
        call exit(1)
      end if
      if (iret.eq.0) read(val,*,iostat=iret) nfiles
      if (iret.ne.0) then
        print'(" lc_clean: please set num_datafiles")'
        call exit(1)
      end if 
      
c get binsize for the lightcurve:
      pname="binsize "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,*,iostat=iret) ttbin
      if (iret.ne.0) then
        ttbin=200.
        print*,' will use 200 sec bins; to override, set parameter binsize'
      end if
      print'(" binsize=",f8.2)',ttbin

c try to get mean rate from par file:
      pname="mean "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,*,iostat=iret) rmean
      force_mean=(iret.eq.0)

c clipping (in sigmas) for calculation of mean:
      pname="clip "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,*,iostat=iret) clip
      if (iret.ne.0) then
        clip=clip0
      else
        if (force_mean) then 
          print'(" Ignoring clip parameter because mean is set")'
        end if
      end if

      if (force_mean) then
        print'(" mean=",f7.4)',rmean
      else
        print'(" clip=",f4.2)',clip
      end if

c get max deviation for the lightcurve:
      pname="max_sigma "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,*,iostat=iret) sigma_max
      if (iret.eq.0) then
        filt_sigma=.true.
        filt_factor=.false.
        print'(" max_sigma=",f5.2)',sigma_max
      else
        filt_sigma=.false.
        filt_factor=.true.
        
c try getting max_factor:
        pname="max_factor "
        call get_param (iret, pfile, pname, val)
        if (iret.eq.0) read(val,*,iostat=iret) factor_max
        if (iret.ne.0) then
          print*,' cannot get either max_sigma or max_factor, will use'
          print*,' max_factor=2'
          factor_max=2
        end if
        print'(" max_factor=",f6.3)',factor_max
      end if


c observ beginning time in seconds (if not set then later take it equal to the
c tstart of the first datafile, which will work with the old observations that
c have chronologic files): 
      pname="tstart "
      call get_param (iret, pfile, pname, val)
      if (iret.ne.0) then
        pname="tbeg "
        call get_param (iret, pfile, pname, val)
      end if 
      if (iret.eq.0) read(val,*,iostat=iret) ttstart
      have_tstart=(iret.eq.0.and.ttstart.gt.0)
        
c whether to ignore (leave in gti) zero photon bins:
      pname="ignore_nodata "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,'(a1)',iostat=iret) a1
      ignore_nodata=(iret.eq.0.and.(a1.eq."y".or.a1.eq."Y"))
        
c whether to ignore (leave in gti) positive spikes of the lightcurve:
      pname="ignore_spikes "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,'(a1)',iostat=iret) a1
      ignore_spikes=(iret.eq.0.and.(a1.eq."y".or.a1.eq."Y"))

c whether to ignore (leave in gti) negative deviations:
      pname="ignore_neg_dev "
      call get_param (iret, pfile, pname, val)
      if (iret.ne.0) then
c       in case of a typo:
        pname="ignore_neg_devs "
        call get_param (iret, pfile, pname, val)
      end if
      if (iret.eq.0) read(val,'(a1)',iostat=iret) a1
      ignore_neg_dev=(iret.eq.0.and.(a1.eq."y".or.a1.eq."Y"))
      if (ignore_neg_dev) print'(" ignore_neg_dev=y")'


c whether to write lc in the form of a normal ascii table (not histogram):
      pname="write_table_lc "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,'(a1)',iostat=iret) a1
      write_table_lc=(iret.eq.0.and.(a1.eq."y".or.a1.eq."Y"))

c whether to write dirty lc for separate acis chips (in addition to sum lc):
      pname="write_separate_chips "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,'(a1)',iostat=iret) a1
      write_separate_chips=(iret.eq.0.and.(a1.eq."y".or.a1.eq."Y"))

c whether to filter by ratio instead of the rate:
      pname="fileref1 "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,'(a1)',iostat=iret) a1
      filt_ratio=(iret.eq.0)
      
      if (filt_ratio) then
        nbands=2
      else
        nbands=1
      end if

      do i=0,maxlc
        rlight(i,1)=0
        rlight(i,2)=0
        do ic=0,9
          rlchip(i,ic)=0
        end do
      end do


c read input gti (will need here for info):
      call read_ggti (ggti,maxgti,ngti,was_fits)

c beg. of gti, for a later decision which tstart to use:
      ttstartgti=ggti(1,1)

      tstart_undecided=.true.

c go through data files:
      do ifile=1,nfiles
        do iband=1,nbands

          if (iband.eq.1) then
            call get_numbered_param (iret,pfile,"file ",ifile,val)
          else
            call get_numbered_param (iret,pfile,"fileref ",ifile,val)
          end if

          if (iret.ne.0) then
            print'(" lc_clean: cannot get file",i3.3,", ignored")',ifile
          else

            call ftgiou (ifi, istat)
            call ftopen (ifi, val, 0, junk, istat)
            call ftmnhd (ifi, -1, "EVENTS", 0, istat)

c tstart keyword from header of 1st file, for a later decision on tstart:
            if (tstart_undecided) then
c (cannot just check for ifile=1 because that file may be missing)
              call ftgkyd (ifi,"TSTART",ttstarthead,a80,istat)
            end if

            call ftgkys (ifi, "INSTRUME", a8, a80, istat)
            if (istat.eq.0) then
              acis=(a8(1:lnblnk(a8)).eq."ACIS")
            else
              acis=.false.
            end if

            call ftgkyj (ifi, "NAXIS2", nrows, a80, istat)
            if (nrows.gt.maxev) then
              print'(" lc_clean: increase maxev in the code or"//
     ~            " split this event file:")'
              print'(" n events = ",i7,", maxev = ",i7)',nrows,maxev
              call exit(0)
            end if
            
            call ftgcno (ifi,.false.,"TIME",ncol,istat)
            call ftgcvd (ifi,ncol, 1,1, nrows, -1, ttime, anyf, istat)

c time of 1st photon in 1st evt file:
            if (tstart_undecided) then
              ttstartevt=ttime(1)
            end if

            if (acis) then
              call ftgcno (ifi,.false.,"CCD_ID",ncol,istat)
              call ftgcvb (ifi,ncol, 1,1, nrows, -1, accd, anyf, istat)
            end if

            call ftclos (ifi,istat)
            call ftfiou (ifi,istat)
            if (istat.ne.0) then
              call ftgerr (istat, a30)
              print'(" lc_clean: fitsio err <",a,"> in file")',
     ~            a30(1:lnblnk(a30))
              print'(" ",a,", ignoring it")',val(1:lnblnk(val))
              istat=0
            else

c Now decide at what time to start the lc:
c if tstart was set explicitly in par file, use that; otherwise,
c use the later of the 3 values: beg of gti, header tstart, time of 1st evt.
c Note that if evt files are not chronological, must have tstart par.
              if (tstart_undecided) then
                if (.not.have_tstart) then
                  ttstart=max(ttstartgti,ttstarthead,ttstartevt)
                  use_gtistart=(ttstart.lt.ttstartgti+0.0001)
c                              (testing if ttstart=ttstartgti)
                end if
                tstart_undecided=.false.
              end if
 
c go through events in this data file:
              ngood=0
            
              do i=1,nrows
                tt=ttime(i)
                if (if_goodttime(tt)) then
                  ngood=ngood+1
                
c add this photon to the lightcurve:
                  k=(tt-ttstart)/ttbin
                  if (k.ge.0.and.k.le.maxlc) then
                    rlight(k,iband)=rlight(k,iband)+1

                    if (acis.and..not.filt_ratio) then
                      ic=ichar(accd(i))
                      if (ic.ge.0.and.ic.le.9) then
                        rlchip(k,ic)=rlchip(k,ic)+1
                        chips(ic)=.true.
                      end if
                    end if

                  else
                    if (k.gt.maxlc) then
                      print'(" lc_clean: increase maxlc in the code:")'
                      print'(" maxlc=",i6,"  tstart=",f15.2,'//
     ~                    '" event t=",f15.2)',maxlc,ttstart,tt

                      call exit(1)
                    else
c an event has t<tstart; OK if par. tstart was set or tstart is taken
c from gti, otherwise not OK: 
                      if (have_tstart.or.use_gtistart) then
c ignore, go to next photon
                      else
                        print'(" lc_clean: multiple evt files are not in chronological order?")'
                        print'(" if so, set a parameter tstart manually.")'
                        print'(" tstart=",f15.2," event t=",f15.2)',
     ~                      ttstart,tt

                        call exit(1)
                      end if
                    end if
                  end if
                end if
              end do
              if (iband.eq.1) then
                print'(" ",a,i7," evt")',val(1:lnblnk(val)),nrows
              else
                print'(" /",a,i7," evt")',val(1:lnblnk(val)),nrows
              end if
            end if
          end if
        end do
      end do
      print*
      
c Lightcurve done (if filt_ratio=true, in 2 bands).
c Now normalize it to cts/s and remove bins that are wholly
c or partially outside of original GTIs, assigning them -1 (partially) or -2
c (either whole bin is outside or both beg and end of the bin are outside).
c The -2 bins will be excluded from the clean GTIs; -1 bins will be
c ignored in calculations and excluded from GTI. Bins wholly within GTI 
c but with zero events will remain 0 (will be handled in a special way).
c Bins -2 have 0 events by way the lc was created. If a bin with both bounds
c outside GTIs has a narrow GTI wholly inside it, it is assigned -1.

      maxlc1=(ggti(ngti,2)-ttstart)/ttbin+1

      mink=maxlc1
      maxk=0
c (will be min and max bins that are at least partially inside the orig gtis)

      itnarrow=0
      itbound=0

      do i=0,maxlc1
        tt=ttstart+i*ttbin
        if (if_goodttime(tt).or.if_goodttime(tt+ttbin)) then
c at least one end of the bin is inside the original GTIs. Check if the good
c fraction of the bin is > okfrac, then correct tbin for this fraction;
c otherwise reject as a boundary bin (this will include bins whose both ends
c are inside gti but which contain a large gti gap inside).
          igap=0
          it0=tt+1
          it1=tt+ttbin-1
          do it=it0,it1
            if (.not.if_goodttime(dble(it))) igap=igap+1
          end do
          ttbin1=ttbin-igap

          if (ttbin1/ttbin.lt.okfrac) then
            rlight(i,1)=-1
            itbound=itbound+ttbin
          else

c bin OK:
            if (.not.filt_ratio) then
              rlight(i,1)=rlight(i,1)/ttbin1

              if (acis) then
                do ic=0,9
                  rlchip(i,ic)=rlchip(i,ic)/ttbin1
                end do
              end if
            else
c rlight(i,1) will contain the ratio in 2 bands:
              if (rlight(i,2).gt.0) then
                rlight(i,1)=rlight(i,1)/rlight(i,2)
              else
                rlight(i,1)=0
              end if
            end if
          end if

          if (i.lt.mink) mink=i
          if (i.gt.maxk) maxk=i

        else
c both ends of the bin are outside gti, but check if this bin encloses
c a narrow gti, to be rejected explicitly (ignore a small probability to have
c a gti > okfrac fully enclosed in the bin):
          it0=tt+1
          it1=tt+ttbin-1
          itnarr=0
          do it=it0,it1
            if (if_goodttime(dble(it))) itnarr=itnarr+1
          end do
          if (itnarr.gt.0) then
            itnarrow=itnarrow+itnarr
            if (i.lt.mink) mink=i
            if (i.gt.maxk) maxk=i
            
            rlight(i,1)=-1
          else
c completely outside the gti and doesn't contain any narrow gti, so won't
c need to do anything about this bin:
            rlight(i,1)=-2
          end if
        end if
      end do


c write uncleaned lightcurves:

      pname="lc_dirty "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) then
c replace ? by instr:
        k1=istrchr(val,"?")
        if (k1.gt.0) then
          if (acis) then
            fname=val(1:k1-1)//"acis"//val(k1+1:lnblnk(val))
          else
            fname=val(1:k1-1)//"hrc"//val(k1+1:lnblnk(val))
          end if
        else
          fname=val
        end if

c write the total detector uncleaned lightcurve for sm:
        ifi=newunit()
        open(ifi,file=fname,iostat=iret)
        if (iret.eq.0) then
          do i=mink,maxk
            if (.not.write_table_lc) then
c write a histogram, excluding bad bins:
              if (rlight(i,1).gt.-1) then

                if (i.eq.mink) then
                  write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin,0.0
                else
                  if (rlight(i-1,1).le.-1) then
                    write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin,0.0
                  end if
                end if

                write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin, rlight(i,1)
                write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin, rlight(i,1)

                if (i.eq.maxk) then
                  write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin,0.0
                else
                  if (rlight(i+1,1).le.-1) then
                    write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin,0.0
                  end if
                end if

              end if

            else
c write an ascii table, listing all bins:
              if (rlight(i,1).gt.-1) then
                write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin+ttbin/2,rlight(i,1)
              else
                write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin+ttbin/2,0.0
              end if
            end if

          end do 
          close (ifi)
        end if

c for acis, also write uncleaned lightcurves for separate chips:
        if (acis.and.write_separate_chips.and..not.filt_ratio) then
          do ic=0,9
            if (chips(ic)) then
              k1=istrchr(val,"?")
              if (k1.gt.0) then
                write(a2,'("c",i1)') ic
                fname=val(1:k1-1)//a2//val(k1+1:lnblnk(val))
              else
                write(fname,'(a,".c",i1)') val(1:lnblnk(val)),ic
              end if

              ifi=newunit()
              open(ifi,file=fname,iostat=iret)
              if (iret.eq.0) then
                do i=mink,maxk

                  if (.not.write_table_lc) then
c write a histogram, excluding bad bins:
                    if (rlight(i,1).gt.-1) then

                      if (i.eq.mink) then
                        write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin,0.0
                      else
                        if (rlight(i-1,1).le.-1) then
                          write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin,0.0
                        end if
                      end if

                      write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin, rlchip(i,ic)
                      write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin,
     ~                    rlchip(i,ic)

                      if (i.eq.maxk) then
                        write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin,0.0
                      else
                        if (rlight(i+1,1).le.-1) then
                          write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin,0.0
                        end if
                      end if
                    end if
                  else
c write an ascii table, listing all bins:
                    if (rlight(i,1).gt.-1) then
                      write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin+ttbin/2,
     ~                    rlchip(i,ic)
                    else
                      write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin+ttbin/2,0.0
                    end if 
                  end if

                end do
                close (ifi)
              end if
            end if
          end do
        end if
      end if 

c now clean the lc:

      if (force_mean) then
        mmean=rmean
        if (filt_ratio) then
          print'(" Using preset mean ratio ",f8.4)',mmean
        else
          print'(" Using preset mean rate ",f8.4," cts/s")',mmean
        end if
      else
c calc mean by 3-sigma clipping:
        mmean=0d0
        mmean2=0d0
        n=0
        do i=mink,maxk
          if (rlight(i,1).gt.0) then
            mmean=mmean+dble(rlight(i,1))
            if (filt_ratio) mmean2=mmean2+dble(rlight(i,2))
            n=n+1
          end if
        end do
        if (n.eq.0) then
          print'(" no valid time bins")'
          call exit(0) 
        end if
c mean before clipping:
        mmean=mmean/n
        if (filt_ratio) mmean2=mmean2/n

        if (filt_ratio) then
c mmean contains ratio, mmean2 contains denominator in cts (not cts/s);
c sigma(n/m)= n/m * sqrt(1/n + 1/m); n=mean*mean2, m=mean2:
          sig=mmean*sqrt(1./(mmean*mmean2)+1./mmean2)
        else
          sig=sqrt(mmean*ttbin)/ttbin
        end if
        rate_min=mmean-clip*sig
        rate_max=mmean+clip*sig

*        if (filt_ratio) then
*          print'(" Using ",f4.1,"-sigma clipping to calculate mean ratio")',
*     ~        clip
*        else
*          print'(" Using ",f4.1,"-sigma clipping to calculate mean rate")',
*     ~        clip
*        end if
        
        mmean=0d0
        mmean2=0d0
        n=0
        do i=mink,maxk
          if (rlight(i,1).gt.0
     ~        .and.rlight(i,1).gt.rate_min.and.rlight(i,1).lt.rate_max) then
            mmean=mmean+dble(rlight(i,1))
            if (filt_ratio) mmean2=mmean2+dble(rlight(i,2))
            n=n+1
          end if
        end do
        if (n.eq.0) then
          print'(" cannot calculate mean, try setting it manually")'
          call exit(0) 
        end if
c mean after clipping:
        mmean=mmean/n
        if (filt_ratio) mmean2=mmean2/n

        if (.not.filt_ratio) then
          print'(" Calculated mean rate ",f8.4," cts/s")',mmean
        else
          print'(" Calculated mean ratio ",f8.4)',mmean
        end if
      end if

      if (filt_sigma) then
        if (filt_ratio) then
          sig=mmean*sqrt(1./(mmean*mmean2)+1./mmean2)
        else
          sig=sqrt(mmean*ttbin)/ttbin
        end if
        rate_min=mmean-sigma_max*sig
        rate_max=mmean+sigma_max*sig
      else
        rate_min=mmean/factor_max
        rate_max=mmean*factor_max
      end if

      if (.not.filt_ratio) then
        print'(" Removing bins with rate outside ",f8.4," -",f8.4," cts/s")',
     ~      rate_min,rate_max
      else
        print'(" Removing bins with ratio outside ",f8.4," -",f8.4)',
     ~      rate_min,rate_max
      end if
c min and max rate done.

 
c to check later how much time we excluded, calc sum of input gtis:
      tt0=0
      do i=1,ngti
        tt0=tt0+ ggti(i,2)-ggti(i,1)
      end do 

      ttz=0
      do i=mink,maxk
c add zero-rate time inside the original GTIs:
        if (rlight(i,1).eq.0.and..not.ignore_nodata) ttz=ttz+ttbin

        if ((rlight(i,1).gt.0 .and.rlight(i,1).gt.rate_max
     ~      .and..not.ignore_spikes)
     ~      .or.
     ~      (rlight(i,1).gt.0 .and.rlight(i,1).lt.rate_min
     ~      .and..not.ignore_neg_dev)
     ~      .or.
     ~      (rlight(i,1).eq.0 .and..not.ignore_nodata)) then

c bad bin, exclude it from gti:
          rlight(i,1)=-1
        end if

        if (rlight(i,1).eq.-1) then
          ttb=ttstart+i*ttbin
          tte=ttstart+(i+1)*ttbin
c exclude from the GTIs the bins that satisfied the above criterion, and in
c addition the -1 bins identified earlier (sitting on the original GTI bounds, 
c or enclosing a narrow GTI, or including a wider-than-okfrac GTI gap,
c but not the -2 bins, which are already completely outside the gtis):

c first, look inside this bin for any gti bounds and reset them to the bin
c bounds, to avoid complications with gtis narrower than the bin:
          do k=1,ngti
            if (ggti(k,1).gt.ttb.and.ggti(k,1).lt.tte) ggti(k,1)=tte
            if (ggti(k,2).gt.ttb.and.ggti(k,2).lt.tte) ggti(k,2)=ttb
          end do

c append end of the bad bin to the column of gti t_beg, and beg of the bad
c bin to the column of gti t_end:
          ngti=ngti+1
          if (ngti.le.maxgti) then
            ggti(ngti,1)=tte
            ggti(ngti,2)=ttb
          else
            print'(" lc_clean: increase maxgti=",i4," in the code. exiting.")'
     ~          ,maxgti
            call exit(1)
          end if 
        end if 
      end do 


c write the cleaned lightcurve:
      pname="lc_clean "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) then
        k1=istrchr(val,"?")
        if (k1.gt.0) then
          if (acis) then
            fname=val(1:k1-1)//"acis"//val(k1+1:lnblnk(val))
          else
            fname=val(1:k1-1)//"hrc"//val(k1+1:lnblnk(val))
          end if
        else
          fname=val
        end if

        ifi=newunit()
        if (iret.eq.0) open(ifi,file=fname,iostat=iret)
        if (iret.eq.0) then
          do i=mink,maxk

            if (.not.write_table_lc) then
c write a histogram, excluding bad bins:
              if (rlight(i,1).gt.-1) then

                if (i.eq.mink) then
                  write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin,0.0
                else
                  if (rlight(i-1,1).le.-1) then
                    write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin,0.0
                  end if
                end if

                write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin, rlight(i,1)
                write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin, rlight(i,1)

                if (i.eq.maxk) then
                  write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin,0.0
                else
                  if (rlight(i+1,1).le.-1) then
                    write(ifi,'(f13.3,f10.5)') ttstart+(i+1)*ttbin,0.0
                  end if
                end if

              end if

            else
c write an ascii table, listing all bins:
              if (rlight(i,1).gt.-1) then
                write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin+ttbin/2, rlight(i,1)
              else
                write(ifi,'(f13.3,f10.5)') ttstart+i*ttbin+ttbin/2, 0
              end if 
            end if

          end do 
          close (ifi)
        end if
      end if


c now reorder the gti t_beg and t_end columns:
      do i=1,ngti
c if any gti low bound < tstart, reset it to tstart (otherwise, if 1st lc
c bin was ok, that part of gti is not excluded - noticed by G Sivakoff):
        if (ggti(i,1).lt.ttstart) ggti(i,1)=ttstart
        jjunk1(i)=ggti(i,1)
        jjunk2(i)=ggti(i,2)
      end do
      call ssort (ngti,jjunk1)
      call ssort (ngti,jjunk2)

c now clean GTIs < 1s (this includes GTIs which now became negative)
c (should exclude only gtis <= 0, but have used 1s steps to 
c check for the presence of narrow gtis inside lc bins, so should also exclude 
c gtis <1s).
c Note that in version <051005, excluded gtis<tbin here; this excluded some
c good bins if there was a narrow gti gap inside. Now, resetting bounds of gtis
c inside bad bins (see above) so this is not necessary.
      tt=0
      kgti=0
      do i=1,ngti
        if (jjunk2(i)-jjunk1(i).gt.1) then
          kgti=kgti+1
          ggti(kgti,1)=jjunk1(i)
          ggti(kgti,2)=jjunk2(i)

          tt=tt+ ggti(kgti,2)-ggti(kgti,1)
        end if 
      end do 
      ngti=kgti
      print'(" Discarded ",i6," s of bad time bins")',int(tt0-tt) 
      print'(" (of them",i6," s zero rate, approx",i6," s boundary bins and narrow GTIs)")',
     ~      int(ttz),itnarrow+itbound
      print*
      print'(" Good time left ",i7," s")',int(tt)


c calc cleaned rate:
      mmean=0d0
      n=0
      do i=mink,maxk
        if (rlight(i,1).gt.-1) then
          mmean=mmean+dble(rlight(i,1))
          n=n+1
        end if
      end do
      if (n.gt.0) then
        if (filt_ratio) then
          print'(" Mean cleaned ratio ",f8.4)',mmean/n
        else
          print'(" Mean cleaned rate ",f8.4," cts/s")',mmean/n
        end if
      end if

      call write_gti (tt,tt0-tt, ggti, maxgti, ngti, was_fits)

*      print*
*      print'(" Compare cleaned and uncleaned lightcurves and if unhappy,")'
*      print'(" try setting the parameter mean to the expected value.")'

      call exit(0) 
      end
*XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

c 31.1.1: take care of ext# in input gti file, if given
c 7.7.00: edited throughout to use real*8 time and gti instead of integer.
c 20.8.99: removed instr from list of args and from filename.

      subroutine write_gti (ttgood,ttdisc, ggti, maxgti, ngti, tobe_fits)

c write fits file with cleaned gti to the clean_gti_file in pfile.
c copies all header stuff from gti_file.

      character*1 pfile*512, pname*512, val*512, f512*512, sig*50,
     ~    history*70, a30*30
      real*8 ggti(maxgti,2), ttgood,ttdisc
c     external unlink
      logical tobe_fits
      common /parf/ pfile


      sig="lc_clean v240307 (M. Markevitch)"

c get name of clean_gti_file and open it:
      pname="clean_gti_file "
      call get_param (iret, pfile, pname, f512)
      if (iret.ne.0) then
        return
c (filename not supplied, assume we don't want to write it)
      end if


c get gti filename from pfile:
      if (tobe_fits) then
        pname="gti_file "
        call get_param (iret, pfile, pname, val)
        if (iret.ne.0) then
          print'(" write_gti: cannot get gti_file name, will write ascii")'
          tobe_fits=.false.
        end if
      end if


      if (tobe_fits) then
c open fits:
        istat = 0
        call ftgiou (in_gti, istat)

        call ftnopn (in_gti, val, 0, istat)

        if (istat.gt.0) then
          call ftgerr (istat, a30)
          print'(" write_gti: fitsio err <",a,"> on file")',a30(1:lnblnk(a30))
          print'("   ",a,", cannot write clean_gti_file")',val(1:lnblnk(val))
          return
        end if 

c get the current ext number (in case in_gti filename was given with ext#):
        call ftghdn (in_gti, nhdu)

c open outfile:
        call unlink (f512)
        call ftgiou (iout_gti, istat)
        call ftinit (iout_gti, f512, 1, istat)

        if (istat.ne.0) then
          call ftgerr (istat, a30)
          print'(" write_gti: fitsio err <",a,"> on file")',a30(1:lnblnk(a30))
          print'(" ",a,", cannot write clean_gti_file")',f512(1:lnblnk(f512))
          return
        end if


c copy 1st header (primary array with info keywords) from in_gti to iout_gti:
        call ftmahd (in_gti, 1, junk, istat)
        call ftcopy (in_gti, iout_gti, 0, istat)


c copy 2nd hdu (or whatever ext# was given in the in_gti filename):
        if (nhdu.ne.1) then
c in_gti filename contains ext#, copy that one:
          call ftmahd (in_gti, nhdu, junk, istat)
        else
c in_gti is a regular gti file, so copy 2nd hdu:
          call ftmahd (in_gti, 2, junk, istat)
        end if

        call ftcrhd (iout_gti, istat)
        call ftcphd (in_gti, iout_gti, istat)
        
c modify naxis2 (nrows) keyword:
        call ftmkyj (iout_gti, "NAXIS2", ngti, "&", istat)
c write data:
        call ftpcld (iout_gti, 1, 1,1, ngti, ggti(1,1),  istat)
        call ftpcld (iout_gti, 2, 1,1, ngti, ggti(1,2),  istat)


c history, checksums, datasums, date stamps, etc. in both hdus:
        call ftmahd (iout_gti, 1, junk, istat)

        call ftukys (iout_gti,"CREATOR",sig," tool that created this file",
     ~      istat)
        call ftpdat (iout_gti, istat)
        call ftpcks (iout_gti, istat)

        call ftmahd (iout_gti, 2, junk, istat)

c add history:
        write(history,'(" ",a," deleted ",i6," s")')
     ~      sig(1:lnblnk(sig)),int(ttdisc)
        call ftphis (iout_gti, history, istat)
        write(history,'(" of anomalous light curve bins, leaving ",'//
     ~       'i7," s of good time.")') int(ttgood)
        call ftphis (iout_gti, history, istat)

        call ftpdat (iout_gti, istat)
        call ftpcks (iout_gti, istat)

c close all:        
        call ftclos (in_gti, istat)
        call ftfiou (in_gti, istat)
        call ftclos (iout_gti, istat)
        call ftfiou (iout_gti, istat)

        close(in_gti)
        close(iout_gti)

        if (istat.ne.0) then
          call ftgerr (istat, a30)
          print'(" write_gti: fitsio err <",a,"> on file")',a30(1:lnblnk(a30))
          print'(" ",a)',f512(1:lnblnk(f512))
        else
          print'(" Wrote ",a)',f512(1:lnblnk(f512))
        end if

      else
c output GTI file will be in ascii format:

        iout_gti=newunit()
        open(iout_gti, file=f512, iostat=iret)

        if (iret.eq.0) then
          do i=1,ngti
            write(iout_gti,'(2f15.3)') ggti(i,1), ggti(i,2)
          end do
        else
          print'(" write_gti: cannot open ",a)',f512(1:lnblnk(f512))
        end if

        close(iout_gti)
      end if
      
      end
