c Maxim Markevitch <maxim % head.cfa.harvard.edu>, last change 30 Jan 7

c Fills sky coords in the ACIS background event file for a given observation.

c 30.1.7: changed string lengths from 128 to 512 (also in get_param.c)
c emandel removed commas from read()/write() for compatib.
c 11.2.5: increased maxev to 4e6 (acisi_D 1.5Ms bg has 3.3e6)
c 13.5.4: increased maxasp from 5e5 to 1.5e6, maxev from 1.5e6 to 2.5e6
c 4.1.2: fixed format of wcs keywords (was TCRVL08, now TCRVL8)
c 11.12.1: now read real*8 time from aoff1 (was integer).
c   see also changes in if_goodttime.f.
c 27.6.1: initialize istat=0, because g77 doesn't. 
c 9.2.1: A. Vikhlinin changed sub. det2sky so now it adds stf_[yz], obviating
c   the need to run asp_apply_sim on the aoff1 file.
c   MM added a check whether it was run.
c   Also: fixed nullval type in fgtcve calls; ichip type 'byte' to int*2.
c 31.1.1: if_goodtime(it) to if_goodttime(dble(it)), to drop if_goodtime
c 21.12.00: removed func ini_pixlib, now a separate file pixlib_int.f
c   (9.2.1: renamed pixlib_int.f -> ini_pixlib.f)
c science evt files.
c 6.6.00: print "Will shift..." added xs,ys
c 15.3.00: cosd to cos
c 5.3.00: started but not finished adding use_time to correct coords in
c 2.2.00: added manual image shifts.
c 28.1.00: now gets name of par file from command line; also changed par names
c as AV asked.

c Uses pieces of from AV's /data/alexey1/chandra/expmap/chipmap.F
c Compile with MMLIBS and
c $B/pixlib_interface.o -L /data/alexey1/chandra/LIB/ -lpix -lmatrix -lparam
c
c Function chip2det is defined in pixlib_interface.c, function det2sky is
c defined in this file.

      parameter (maxev=4 000 000, maxasp=1 500 000, 
     ~    x0=4096.5, y0=4096.5, pix=0.492, dx=-pix/3600, dy=pix/3600)
      character*1 pfile*512, pname*512, val*512, bgfile*512, a80*80, a30*30,
     ~    fpsys*80, aimpoint*200, a81*8,a82*8,a83*8,a84*8, a1*1, b80*80
      integer*2 icx(maxev), icy(maxev), ichip(maxev)
      real detx(maxev), dety(maxev), x(maxev), y(maxev),
     ~    xoff(maxasp), yoff(maxasp), roll(maxasp),
     ~    stf_y(maxasp), stf_z(maxasp)
      real*8 tt(maxasp)
      logical if_goodttime, anyf, use_time
      common /parf/ pfile
      idum=111
      istat=0
      
      print*
      print'(" This is make_acisbg v300107")'
      print*


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

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


c read aimpoint pars (sim_x,sim_y,sim_z) and fpsys from the events file (in
c fact, sim_x etc. can also be read from the aoff file, but that file does not
c have fpsys):


      pname="evt_file "
      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.ne.0) then
        pname="evtfile "
        call get_param (iret, pfile, pname, val)
        if (iret.ne.0) then
          print'(" Please provide parameter evt_file.")'
          call exit(1)
        end if
      end if

      call ftgiou (ifi, istat)
      call ftopen (ifi, val, 0, junk, istat)
      call ftmnhd (ifi, -1, "EVENTS", 0, istat)
      
      call ftgkye (ifi,"SIM_X",simx,a80,istat)
      call ftgkye (ifi,"SIM_Y",simy,a80,istat)
      call ftgkye (ifi,"SIM_Z",simz,a80,istat)
      call ftgkys (ifi,"ACSYS3",fpsys,a80,istat)

      call ftclos (ifi,istat)
      call ftfiou (ifi,istat)

      if (istat.ne.0) then
        call ftgerr (istat, a30)
        print'(" fitsio error <",a,"> on file")',a30(1:lnblnk(a30))
        print'("   ",a)',val(1:lnblnk(val))
        call exit(1) 
      end if

c initialize pixlib:

      write(aimpoint,'(f9.4,",",f9.4,",",f9.4)') simx,simy,simz
      call rmblanks (aimpoint)
      
      iret=ini_pixlib(aimpoint,fpsys)

      if (iret.ne.0) then
        print'(" (Check your CIAO setup)")'
        call exit(0)
      end if

c read time, x,y offsets and roll offsets from the *aoff1* file:

      pname="aoff1_file "
      call get_param (iret, pfile, pname, val)
      if (iret.ne.0) then
        pname="aspfile "
        call get_param (iret, pfile, pname, val)
        if (iret.ne.0) then
          print'(" Please provide parameter aoff1_file.")'
          call exit(1) 
        end if
      end if

      call ftgiou (ifi, istat)
      call ftopen (ifi, val, 0, junk, istat)

c check if asp_apply_sim was not run:
      call ftgkys (ifi,"CREATOR",b80,a80,istat)
      if (b80(1:13).eq."asp_apply_sim") then
        print*
        print'(" It appears that the aoff file has been processed by asp_apply_sim. Make_acisbg")'
        print'(" now needs the original file, please change the aoff1_file parameter.")'
        call exit(0)
      end if 

      call ftmnhd (ifi, -1, "ASPOFF", 0, istat)
      call ftgkyj (ifi, "NAXIS2", nrows, a80, istat)
      
      if (nrows.gt.maxasp) then
        print*,' Number of records ',nrows,
     ~      ' > maxasp, increase maxasp in the code. Proceeding...'
        nrows=maxasp
      end if
      
      call ftgcno (ifi, .false., "time",  ncol, istat)
      call ftgcvd (ifi, ncol, 1,1, nrows, -1, tt, anyf, istat)
      
      call ftgcno (ifi, .false., "x_offsets",  ncol, istat)
      call ftgcve (ifi, ncol, 1,1, nrows, 0., xoff, anyf, istat)
      
      call ftgcno (ifi, .false., "y_offsets",  ncol, istat)
      call ftgcve (ifi, ncol, 1,1, nrows, 0., yoff, anyf, istat)
      
      call ftgcno (ifi, .false., "roll_offsets",  ncol, istat)
      call ftgcve (ifi, ncol, 1,1, nrows, 0., roll, anyf, istat)

      call ftgcno (ifi, .false., "stf_y",  ncol, istat)
      call ftgcve (ifi, ncol, 1,1, nrows, 0., stf_y, anyf, istat)

      call ftgcno (ifi, .false., "stf_z",  ncol, istat)
      call ftgcve (ifi, ncol, 1,1, nrows, 0., stf_z, anyf, istat)
    
      call ftgkye (ifi, "RA_NOM", ranom, a80, istat)
      call ftgkye (ifi, "DEC_NOM", decnom, a80, istat)
      call ftgkye (ifi, "ROLL_NOM", rollnom, a80, istat)

      call ftclos (ifi,istat)
      call ftfiou (ifi,istat)

      if (istat.ne.0) then
        call ftgerr (istat, a30)
        print'(" fitsio error <",a,"> on file")',a30(1:lnblnk(a30))
        print'("   ",a)',val(1:lnblnk(val))
        call exit(1) 
      end if


c discard time bins outside GTI, and also add rolloff to roll_nom:
      k=0
      do i=1,nrows
        if (if_goodttime(tt(i))) then
          k=k+1
          xoff(k)=xoff(i)
          yoff(k)=yoff(i)
          stf_y(k)=stf_y(i)
          stf_z(k)=stf_z(i)
          roll(k)=rollnom+roll(i)
        end if 
      end do
      write (0,*) 'POINTS : ',k
      if (k.eq.0) then
        print*,' Aspect file does not have any points inside GTI.'
        call exit(1) 
      end if
c now k is the total number of good aspect offsets.


c read bg file:

      pname="bg_file "
      call get_param (iret, pfile, pname, bgfile)
      if (iret.ne.0) then
        print'(" Please provide parameter bg_file.")'
        call exit(1) 
      end if

c see if we want to use the time column in the bg file instead of generating
c times randomly (this is for correcting the science evt files after pixlib
c updates):

      pname="use_time "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,'(a1)',iostat=iret) a1
      use_time=(iret.eq.0.and.(a1.eq."y".or.a1.eq."Y"))
*      if (use_time) then
*        print'(" Will use time column in bg_file to calculate sky coords;")'
*        print'(" only events within GTI will be modified, and x,y for others will be set to 0.")'
*      end if


      call ftgiou (ifi, istat)
      call ftopen (ifi, bgfile, 1, junk, istat)
      call ftmnhd (ifi, -1, "EVENTS", 0, istat)
      call ftgkyj (ifi, "NAXIS2", nrows, a80, istat)
      
      if (nrows.gt.maxev) then
        print*,' Number of events ',nrows,
     ~      ' > maxn, increase maxn in the code. Proceeding...'
        nrows=maxev
      end if
      
      call ftgcno (ifi, .false., "ccd_id",  ncol, istat)
      call ftgcvi (ifi, ncol, 1,1, nrows, -1, ichip, anyf, istat)
      
      call ftgcno (ifi, .false., "chipx",  ncol, istat)
      call ftgcvi (ifi, ncol, 1,1, nrows, -1, icx, anyf, istat)
      
      call ftgcno (ifi, .false., "chipy",  ncol, istat)
      call ftgcvi (ifi, ncol, 1,1, nrows, -1, icy, anyf, istat)

*      if (use_time) then
*        call ftgcno (ifi, .false., "time",  ncol, istat)
*        call ftgcvj (ifi, ncol, 1,1, nrows, -1, itime, anyf, istat)
*      end if


      if (istat.ne.0) then
        call ftgerr (istat, a30)
        print'(" fitsio error <",a,"> on file")',a30(1:lnblnk(a30))
        print'("   ",a)',bgfile(1:lnblnk(bgfile))
        call exit(1) 
      end if


c read shifts to apply to x,y coords (in arcsec), if provided:

      pname="bg_x_shift "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,*,iostat=iret) xs
      if (iret.ne.0) xs=0
      
      pname="bg_y_shift "
      call get_param (iret, pfile, pname, val)
      if (iret.eq.0) read(val,*,iostat=iret) ys
      if (iret.ne.0) ys=0

      if (xs.ne.0.or.ys.ne.0) then
        print'(" Will shift background sky coords by",2f8.2," arcsec")',xs,ys
      end if

      xs=xs/pix
      ys=ys/pix


c now calc sky coords for each bg event by calling pixlib:

      kt=1
      do i=1,nrows
        cx=icx(i)
        cy=icy(i)
        ich=ichip(i)

        call chip2det (cx,cy,ich,detx(i),dety(i))

        if (use_time) then
          print*,' use_time not yet implemented'
          call exit(0)
*          if (if_goodttime(dble(itime(i)))) then
*          else
*            x(i)=0
*            y(i)=0
*          end if
        else

c convert det to sky choosing aspect offsets and roll randomly: 
          j=k*urand(idum)+1
          if (j.gt.k) j=k

          call det2sky (detx(i),dety(i),xoff(j),yoff(j),roll(j),stf_y(j)
     ~        ,stf_z(j),x(i),y(i))
        end if


c apply user-supplied shifts to sky coords:
        x(i)=x(i)+xs
        y(i)=y(i)+ys
      end do


c update detx,dety,x,y columns in the bg events file; also, update ra_nom and
c crval keywords:

      call ftgcno (ifi, .false., "detx",  ncol, istat)
      call ftpcle (ifi, ncol, 1,1, nrows, detx, istat)

      call ftgcno (ifi, .false., "dety",  ncol, istat)
      call ftpcle (ifi, ncol, 1,1, nrows, dety, istat)

c x:
      call ftgcno (ifi, .false., "x",  ncol, istat)
      call ftpcle (ifi, ncol, 1,1, nrows, x, istat)

c update WCS keywords for x, if exist already:
      if (ncol.le.9) then
        write(a81,'("TCTYP",i1)') ncol
        write(a82,'("TCRVL",i1)') ncol
        write(a83,'("TCRPX",i1)') ncol
        write(a84,'("TCDLT",i1)') ncol
      else
        write(a81,'("TCTYP",i2)') ncol
        write(a82,'("TCRVL",i2)') ncol
        write(a83,'("TCRPX",i2)') ncol
        write(a84,'("TCDLT",i2)') ncol
      end if
      call ftukys (ifi,a81,"RA---TAN"," ",istat)
      call ftukyf (ifi,a82,ranom,6," Nominal RA",istat)
      call ftukyf (ifi,a83,x0,1," ",istat)
      call ftukye (ifi,a84,dx,7," ",istat)
      

c y:
      call ftgcno (ifi, .false., "y",  ncol, istat)
      call ftpcle (ifi, ncol, 1,1, nrows, y, istat)

c update WCS keywords for y, if exist already:
      if (ncol.le.9) then
        write(a81,'("TCTYP",i1)') ncol
        write(a82,'("TCRVL",i1)') ncol
        write(a83,'("TCRPX",i1)') ncol
        write(a84,'("TCDLT",i1)') ncol
      else
        write(a81,'("TCTYP",i2)') ncol
        write(a82,'("TCRVL",i2)') ncol
        write(a83,'("TCRPX",i2)') ncol
        write(a84,'("TCDLT",i2)') ncol
      end if
      call ftukys (ifi,a81,"DEC--TAN"," ",istat)
      call ftukyf (ifi,a82,decnom,6," Nominal Dec",istat)
      call ftukyf (ifi,a83,y0,1," ",istat)
      call ftukye (ifi,a84,dy,7," ",istat)
      

      call ftukyf (ifi,"RA_NOM",ranom,6," Nominal RA",istat)
      call ftukyf (ifi,"DEC_NOM",decnom,6," Nominal Dec",istat)
      call ftukyf (ifi,"ROLL_NOM",rollnom,6," Nominal Roll",istat)

      call ftclos (ifi,istat)
      
      if (istat.ne.0) then
        call ftgerr (istat, a30)
        print'(" fitsio error <",a,"> on file")',a30(1:lnblnk(a30))
        print'("   ",a)',bgfile(1:lnblnk(bgfile))
        call exit(1) 
      end if

      call exit(0)
      end
*XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
c changed on 7.2.1 by AV, now adds stf_[yz]

      subroutine det2sky (detx,dety,xoff,yoff,roll,stf_y,stf_z,x,y)

      parameter (detx0=4096.5,dety0=4096.5,x0=4096.5,y0=4096.5)
      real deg2rad
      parameter (deg2rad=3.1415926536/180.0)
      real sinroll, cosroll, dx, dy, pix2mm
      parameter (pix2mm=41.6892) 
c               (assuming 1 pixel is 23.987 micron)

      call theta_phi (detx0,dety0,detx,dety,r,phi)
      beta=360-roll+phi

      sinroll = sin(-roll*deg2rad)
      cosroll = cos(-roll*deg2rad)

      dx = xoff + ( stf_y*cosroll + stf_z*sinroll ) * pix2mm
      dy = yoff + ( stf_y*sinroll - stf_z*cosroll ) * pix2mm

      x=x0+r*cos(beta*deg2rad)+dx
      y=y0+r*sin(beta*deg2rad)+dy

      end
