!
!  munilist
!
!  Copyright © 2011-3 F.Hroch (hroch@physics.muni.cz)
!
!  This file is part of Munipack.
!
!  Munipack is free software: you can redistribute it and/or modify
!  it under the terms of the GNU General Public License as published by
!  the Free Software Foundation, either version 3 of the License, or
!  (at your option) any later version.
!  
!  Munipack is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU General Public License for more details.
!  
!  You should have received a copy of the GNU General Public License
!  along with Munipack.  If not, see <http://www.gnu.org/licenses/>.


module mlist

  implicit none

  integer, parameter, private :: dbl = selected_real_kind(15)
  real(dbl), parameter, private :: rad = 57.295779513082322865_dbl

  integer, private :: nfile,gncoo,gnaperture
  integer, dimension(:), allocatable, private :: gyear,gmonth,gday,ghour,gminute
  real(dbl), dimension(:), allocatable, private :: gra,gdec,gsec,gexposure,gjulday, &
       garea,gzeroflux,gctflux,gdctflux
  real(dbl), dimension(:), allocatable, private :: gxcoo,gycoo,gvxcoo,gvycoo
  real(dbl), dimension(:,:), allocatable, private :: gdata
  character(len=80),dimension(:), allocatable, private :: gfitskeys,gfitsval,gheadkeys,&
       gheadval,gfilters,gcols
  character(len=80), private :: gmode, gcootype, gdateobs, gfilter
  real(dbl), private :: gaperture,gtol,gzeromag,gflux0,gepoch,gequinox,gexptime
  logical, private :: gmags,gfluxes,gcalibr,gdiffmag,verbose,gfileprint

contains

  subroutine munilist_init(mode,nfiles,fitskeys,headkeys,cols,aperture,naperture,&
       tol,zeromag,flux0,epoch,equinox,mags,fluxes,calibr,diffmag,verb,fileprint)

    character(len=*), intent(in) :: mode
    integer, intent(in) :: nfiles, naperture
    character(len=*), dimension(:), intent(in) :: fitskeys, headkeys, cols
    real(dbl), intent(in) :: aperture,tol,zeromag,flux0,epoch,equinox
    logical, intent(in) :: mags,fluxes,calibr,diffmag,verb,fileprint
    integer :: ncols
    
    gmode = mode
    ncols = size(cols)
    if( ncols == 0 ) stop 'munilist_init: undefined cols (try --mag, --flux or --col)'
    if( allocated(gfitskeys) ) stop 'munilist_init: gfitskeys already allocated.'
    allocate(gfitskeys(size(fitskeys)),gfitsval(size(fitskeys)),gheadkeys(size(headkeys)),&
         gheadval(size(headkeys)),gcols(size(cols)))
    gfitskeys = fitskeys
    gheadkeys = headkeys
    gcols = cols
    allocate(gyear(nfiles),gmonth(nfiles),gday(nfiles),ghour(nfiles),gminute(nfiles), &
         gsec(nfiles),gfilters(nfiles),gexposure(nfiles),gjulday(nfiles),&
         gra(nfiles),gdec(nfiles),garea(nfiles),gzeroflux(nfiles),gctflux(nfiles),&
         gdctflux(nfiles))
    nfile = 0
    gtol = tol
    gaperture = aperture
    gnaperture = naperture
    gzeromag = zeromag
    gflux0 = flux0
    gepoch = epoch
    gequinox = equinox
    gmags = mags
    gfluxes = fluxes
    gcalibr = calibr
    gdiffmag = diffmag
    verbose = verb
    gfileprint = fileprint
!    write(*,*) nfiles,ncols

  end subroutine munilist_init

! ------

  subroutine munilist_coo(cootype,xcoo,ycoo,vxcoo,vycoo)
    
    character(len=*), intent(in) :: cootype
    real(dbl), dimension(:), intent(in) :: xcoo,ycoo,vxcoo,vycoo
    integer :: n

    n = size(xcoo)
    if( allocated(gxcoo) ) stop 'munilist_coo: gxcoo already allocated.'
    allocate(gxcoo(n),gycoo(n),gvxcoo(n),gvycoo(n))
    gxcoo = xcoo
    gycoo = ycoo
    gvxcoo = vxcoo
    gvycoo = vycoo
    gcootype = cootype

    if( allocated(gdata) ) stop 'munilist_coo: gdate already allocated.'
    
    gncoo = n
    allocate(gdata(size(gyear),n*size(gcols)))


  end subroutine munilist_coo

! ------

  subroutine munilist_add(filename)

    use fitsio
    use trajd
    use astrosphere

!    use traco
    use astrotrafo
    use mtable

    character(len=*), intent(in) :: filename

    character(len=80) :: ctype,filter,phsystem
    character(len=666) :: fmt = ""
    integer :: i,j,ij,n, ndata, status
    real(dbl) :: year,month,day,hour,min,sec,exptime,area,jd,r,rmin,dt,tol,dtol, &
         scale,angle,ctflux,dctflux,zeromag,zeroflux,gain,feff,fwidth,feff,ffwhm,leff,lfwhm,
    real(dbl),dimension(:), allocatable :: x,y
    real(dbl),dimension(:,:), allocatable :: data,xdata
    real(dbl), dimension(:), allocatable :: a,d,u,v,mag,dmag,flux,dflux
    real(dbl), dimension(2) :: crval, crpix
    type(TypeProjection) :: t


    call table(filename, gfitskeys, gheadkeys, gcols, gaperture, gnaperture, verbose,gfitsval,&
         gheadval,year,month,day,hour,min,sec,exptime,area,gain,filter,phsystem,gcootype,ctype,crpix,crval, &
         scale,angle,dtol,fnuref,flamref,leff,lfwhm,feff,ffwhm,ctflux,dctflux,x,y,data,status)

    gdateobs = gfitsval(1)
    if( status /= 0 ) then
       if( allocated(x) ) deallocate(x)
       if( allocated(y) ) deallocate(y)
       if( allocated(data) ) deallocate(data)
       return
    end if

    if( gmode == 'lc' .and. .not. allocated(gxcoo) ) then

       n = size(x)
       allocate(gxcoo(n),gycoo(n),gvxcoo(n),gvycoo(n))
       t%type = ctype
       t%acen = crval(1)
       t%dcen = crval(2)
       t%xcen = crpix(1)
       t%ycen = crpix(2)
       t%scale = scale
       t%pa = angle
       call invtrafo(t,x,y,gxcoo,gycoo)
       gvxcoo = 0.0_dbl
       gvycoo = 0.0_dbl
       gcootype = 'equatorial'

       if( allocated(gdata) ) stop 'munilist_coo: gdate already allocated.'
    
       gncoo = n
       allocate(gdata(size(gyear),n*size(gcols)))
    end if

    ! Evaluate Julian date at half of exposure 
    jd = datjd(year,month,day + (hour + (min + sec/60.0)/60.0)/24.0)
    jd = jd + exptime/2.0/86400.0
    
    ! look for coordinates
    if( allocated(gxcoo) ) then

       n = size(gxcoo)
       allocate(a(n),d(n),u(n),v(n))
       do j = 1, n
          dt = jd - gepoch!jd0
          a(j) = gxcoo(j) + gvxcoo(j)*dt
          d(j) = gycoo(j) + gvycoo(j)*dt
       end do

       t%type = ctype    
       t%acen = crval(1)
       t%dcen = crval(2)
       t%xcen = crpix(1)
       t%ycen = crpix(2)
       t%scale = scale
       t%pa = angle
    
       call trafo(t,a,d,u,v)
       !    write(*,*) a,d,u,v

       if( gtol > 0.0 ) then
          tol = gtol
       else
          ! one looks strange, but 1pix is prefered over dtol=0.0
          tol = 10.0*max(dtol,1.0/scale)
       end if
       tol = scale*tol
       
       ! locate stars on base of euclidean metric
       ndata = size(gcols)
       allocate(xdata(n,ndata))
       !    tol = max(,xtol)
       !    write(*,*) tol,scale
       do j = 1, n

          rmin = huge(rmin)
          ij = 0

          do i = 1, size(x)
             r = sqrt((x(i) - u(j))**2 + (y(i) - v(j))**2)
             !          write(*,'(5f10.3)') x(i),u(j),y(i),v(j),r
             if( r < tol .and. r < rmin) then
                rmin = r
                ij = i
             end if
          end do
          
          if( ij > 0 ) then
             xdata(j,:) = data(ij,:)
          else
             xdata(j,:) = 0.0
             if( verbose ) write(*,'(a,2(f0.5,1x),"(",2(f0.1,1x),"[pix]) ",a,g0.5)') &
                  'Object at ',a(j),d(j),u(j),v(j),' not found: r=',r
          end if
       end do

       deallocate(u,v)

    else

       n = size(x)
       ndata = size(gcols)
       allocate(a(n),d(n),xdata(n,ndata))
       xdata = data

       t%type = ctype
       t%acen = crval(1)
       t%dcen = crval(2)
       t%xcen = crpix(1)
       t%ycen = crpix(2)
       t%scale = scale
       t%pa = angle
       call invtrafo(t,x,y,a,d)
       

    end if

    ! update globals
    nfile = nfile + 1
    gra(nfile) = a(1)
    gdec(nfile) = d(1)
    gyear(nfile) = year
    gmonth(nfile) = month
    gday(nfile) = day
    ghour(nfile) = hour
    gminute(nfile) = min
    gsec(nfile) = sec
    gexposure(nfile) = exptime
    garea(nfile) = area
    gzeroflux(nfile) = zeroflux
    gctflux(nfile) = ctflux
    gdctflux(nfile) = dctflux
    gfilters(nfile) = filter
    gjulday(nfile) = jd


    if( gmode == 'lc' ) then
       ! save LC

       if( gmags .or. gfluxes ) then

          r = exptime*area

          allocate(flux(n),dflux(n))
          where( xdata(:,1) > 0.0_dbl )
             flux = xdata(:,1)/r
             dflux = xdata(:,2)/r
          elsewhere
             flux = xdata(:,1)
             dflux = xdata(:,2)
          end where
          if( gcalibr ) then
             where( flux > 0.0_dbl )
                flux = ctflux*flux 
                dflux = dctflux*dflux 
             end where
          end if

          if( gmags ) then
             
             allocate(mag(n),dmag(n))
             if( gcalibr ) then
                zeromag = 2.5_dbl*log10(zeroflux)
             else
                zeromag = gzeromag
             end if
             call magnitudes(zeromag,flux,dflux,mag,dmag)
             
             !       if( gmags ) then
             
             !          allocate(mag(n),dmag(n))
             !          call magnitudes(gzeromag,xdata(:,1),xdata(:,2),mag,dmag)
             write(fmt,'(a,i0,a)') "(1x,f0.10,1x,3a,1x,",2*n,"(1x,f0.5))"

             if( gdiffmag ) then

                do i = 2,n
                   if( mag(i) < 99.0 .and. mag(1) < 99.0 ) then
                      mag(i) = mag(i) - mag(1)
                      dmag(i) = sqrt(dmag(i)**2+dmag(1)**2)
                   else
                      mag(i) = 99.99999_dbl
                      dmag(i) = 9.99999_dbl
                   end if
                end do
                
                write(*,fmt) jd,"'",trim(filter),"'",(mag(i),dmag(i),i=2,n)
                gdata(nfile,:) = (/(mag(i),dmag(i),i=2,n)/)
                
             else
                
                !          if( .not. gcalibr ) then
             
                write(*,fmt) jd,"'",trim(filter),"'",(mag(i),dmag(i),i=1,n)
                gdata(nfile,:) = (/(mag(i),dmag(i),i=1,n)/)
                
                !          else
                
                !             do i = 2,n
                !                mag(i) = mag(i) - mag(1)
                !                dmag(i) = sqrt(dmag(i)**2+dmag(1)**2)
                !             end do
                
                !             write(*,fmt) jd,"'",trim(filter),"'",(mag(i),dmag(i),i=2,n)
                !             gdata(nfile,:) = (/(mag(i),dmag(i),i=2,n)/)
             
             end if
!          end if
             deallocate(mag,dmag)

          else if( gfluxes ) then

             !          allocate(flux(n),dflux(n))
             !          r = exptime*area
             !          flux = xdata(:,1)/r
             !          dflux = xdata(:,2)/r
             write(fmt,'(a,i0,a)') "(1x,f0.10,1x,3a,1x,",2*n,"(1x,f0.5))"
             write(*,fmt) jd,"'",trim(filter),"'",(flux(i),dflux(i),i=1,n)
             gdata(nfile,:) = (/(flux(i),dflux(i),i=1,n)/)
          end if
          deallocate(flux,dflux)
          
       else 

          if( gfileprint ) write(*,'(3a)',advance="no") "'",trim(filename),"'"

          write(*,'(1x,i4.4,tr1,4(i2.2,tr1),f6.3,tr1,f6.1,tr1,3a)',advance="no") &
               int(year),int(month),int(day),int(hour),int(min),sec,exptime,"'",trim(filter),"'"

          if( size(gheadval) > 0 ) &
               write(*,'(1000a)',advance="no") (" '"//trim(gheadval(i))//"'",i=1,size(gheadval))
       
          write(*,"(tr2,f20.10)",advance="no" ) jd

          if( gcootype == 'horizontal' ) then

!          if( alpha >= 0.0 .and. abs(lat) <= 90.0 )then
!             ha = hangle(lmst(jd,long)*15.0_dbl,alpha)
!             call eq2hor(ha,delta,lat,azimut,elev)
!             airm = airmass(90.0_dbl-elev)
!             write(*,'(2f10.5,f10.5)',advance="no") azimut,elev,airm
!          end if

          else if( gcootype == 'pixels' ) then

!             write(*,'(2000f10.3)',advance="no") (gxcoo(i),gycoo(i),i=1,n)
             !          write(*,'(2000f10.3)',advance="no") (u(i),v(i),i=1,n)
          
          else if( gcootype == 'equatorial' ) then

             call invtrafo(t,gxcoo,gycoo,a,d)
             !          call invtrafo(t,u,v,a,d)
             write(*,'(2000f12.5)',advance="no") (a(i),d(i),i=1,n)
             
          end if

          write(*,*) ((xdata(i,j),j=1,ndata),i = 1,n)

          ! save LC
          n = size(x)
          ndata = size(gcols)
!          do i = 1,n
!             gdata(nfile,1+(i-1)*ndata:1+i*ndata) = xdata(i,:)
!          end do
          gdata(nfile,:) = pack(xdata,.true.)!,(/1,n*ndata/))
          
       end if



    else if( gmode == 'cat' ) then

       ! save star field
       if( allocated(gdata) ) deallocate(gdata)
       allocate(gdata(size(xdata,1),size(xdata,2)))
       
       if( gmags .or. gfluxes ) then

          r = exptime*area
             
          allocate(flux(n),dflux(n))
          where( xdata(:,1) > 0.0_dbl )
             flux = xdata(:,1)/r
             dflux = xdata(:,2)/r
          elsewhere
             flux = xdata(:,1)
             dflux = xdata(:,2)
          end where
          if( gcalibr ) then
             where( flux > 0.0_dbl )
                flux = ctflux*flux 
                dflux = dctflux*dflux 
             end where
          end if

          if( gmags ) then

             allocate(mag(n),dmag(n))
             if( gcalibr ) then
                zeromag = 2.5_dbl*log10(zeroflux)
             else
                zeromag = gzeromag
             end if
             call magnitudes(zeromag,flux,dflux,mag,dmag)
!             call magnitudes(zeromag,xdata(:,1),xdata(:,2),mag,dmag)
             do i = 1, n
                write(*,"(2(f0.7,1x),2(f0.5,1x))") a(i),d(i),mag(i),dmag(i)
                gdata(i,:) = (/mag(i),dmag(i)/)
             end do
             deallocate(mag,dmag)

          else if( gfluxes ) then
             do i = 1, n
                write(*,"(2(f0.7,1x),2(en17.7,1x))") a(i),d(i),flux(i),dflux(i)
                gdata(i,:) = (/flux(i),dflux(i)/)
             end do
          end if

          deallocate(flux,dflux)

       else
          do i = 1,n
             write(*,*) a(i),d(i),(xdata(i,j),j=1,ndata)
             gdata(i,:) = (/(xdata(i,j),j=1,ndata)/)
          end do
       end if

       deallocate(gra,gdec)
       allocate(gra(size(a)),gdec(size(d)))
       gra = a
       gdec = d

    end if

    deallocate(x,y,xdata,data)

end subroutine munilist_add


! ----------------

  subroutine magnitudes(zeromag,flux,dflux,mag,dmag)

    real(dbl), intent(in) :: zeromag
    real(dbl), dimension(:), intent(in) :: flux,dflux
    real(dbl), dimension(:), intent(out) :: mag,dmag

    where( flux > 0.0 )
       mag = zeromag - 2.5_dbl*log10(flux)
       dmag = 1.086_dbl*dflux/flux
    elsewhere
       mag = 99.99999_dbl
       dmag = 9.99999_dbl
    end where

  end subroutine magnitudes

! ----------------



  subroutine munilist_finish(output,backup)

    use savetables

    character(len=*), intent(in) :: output,backup
    character(len=80), dimension(:), allocatable :: cols, fmtcols
    character(len=80) :: dateobs
    integer :: status, i, j, n

    if( output /= '' .and. nfile > 0 ) then

       if( gmode == 'lc' ) then

          if( gmags .or. gfluxes ) then

             if( gcalibr .and. gmags ) then
                n = gncoo - 1
             else
                n = gncoo
             end if
             allocate(cols(2*n),fmtcols(2))
             if( gmags ) then
                fmtcols(1) = '("MAG_",i0)'
                fmtcols(2) = '("MAGERR_",i0)'
             else if( gfluxes ) then
                fmtcols(1) = '("FLUX_",i0)'
                fmtcols(2) = '("FLUXERR_",i0)'
             end if
             do i = 1,n
                do j = 1,2
                   write(cols(2*(i-1)+j),fmtcols(j)) i
                end do
             end do
             deallocate(fmtcols)

          else
             
             n = size(gcols)
             allocate(cols(n*gncoo),fmtcols(n))
             do j = 1,n
                fmtcols(j) = '("'//trim(gcols(j))//'_",i0)'
             end do
             do i = 1,gncoo
                do j = 1,n
                   write(cols(n*(i-1)+j),fmtcols(j)) i
                end do
             end do             
             deallocate(fmtcols)
             
          end if

          call savelc(output,backup,'MUNIPACK_LC',cols,gfitskeys,gfitsval,&
               gaperture,gequinox,&
!               gaperture,gequinox,gyear,gmonth,gday,ghour,gminute,gsec,&
               gexposure,gjulday,gfilters,gxcoo,gycoo,gdata(:,1:size(cols)))
          
       else if( gmode == 'cat' ) then
 
          allocate(cols(size(gcols)))
          cols = gcols

          status = 0
          call fttm2s(int(gyear(1)),int(gmonth(1)),int(gday(1)),int(ghour(1)),&
               int(gminute(1)),gsec(1),3,dateobs,status)
          call savecat(output,backup,'MUNIPACK_CAT',cols,gfitskeys,gfitsval,&
          dateobs,gfilters(1),gexposure(1),gaperture,gequinox,gra,gdec,gdata)
          
       end if

       if( allocated(cols) ) deallocate(cols)

    end if

    if( allocated(gyear) ) deallocate(gyear,gmonth,gday,ghour,gminute,gsec,gfilters,&
         gexposure,gra,gdec,gjulday)
    if( allocated(gdata) ) deallocate(gdata)
    if( allocated(gxcoo) ) deallocate(gxcoo,gycoo,gvxcoo,gvycoo)
    if( allocated(gfitskeys) ) deallocate(gfitskeys,gfitsval,gheadval,gcols)

    if(nfile==0) stop 'No apropriate files on input. Perhaps astrometry or photometry unavailable?'

  end subroutine munilist_finish

end module mlist



!!!  subroutine munilist(mode,filename,output,aperture,xcoo,ycoo,vxcoo,vycoo,xtol, &
!!!!  subroutine munilist(mode,filename,output,idx,xcoo,ycoo,vxcoo,vycoo,xtol, &
!!!       zeromag, &
!!!!    min0,per,long,lat,alpha,delta,
!!!       jd0,mags,fluxes,instrmag,&
!!!!       full,positions,header, &
!!!       verbose,fileprint,cootype,headkeys,selcols,fitskeys, object,observer,author,instrument,telescope, &
!!!               origin,reference,equinox)
!!!
!!!!    use cfitsio  ! consider fitsio
!!!    use fitsio
!!!    use trajd
!!!    use traco
!!!    use astrotrafo
!!!    use mtable
!!!    use savetables
!!!
!!!!!$    interface
!!!!!$       subroutine storelc(ra,de,eqx,y,m,d,h,min,s,e,jd,fl,dd)
!!!!!$         integer, intent(in) :: y,m,d,h,min
!!!!!$         integer, parameter :: dbl = selected_real_kind(15)
!!!!!$         real(dbl), intent(in) :: ra,de,eqx,s,e,jd
!!!!!$         real(dbl), dimension(:), intent(in) :: dd
!!!!!$         character(len=*),intent(in) :: fl
!!!!!$       end subroutine storelc
!!!!!$    end interface
!!!
!!!    character(len=*), intent(in) :: mode, filename, output, cootype
!!!    character(len=*), dimension(:), intent(in) :: fitskeys, headkeys, selcols
!!!    character(len=*), intent(in) :: object,observer,author,instrument, &
!!!         telescope,origin,reference
!!!!    integer, dimension(:), intent(in) :: idx
!!!    real(dbl),dimension(:),intent(in) :: xcoo, ycoo, vxcoo, vycoo
!!!    real(dbl),intent(in) :: aperture,xtol, zeromag, equinox!, min0,per,long, lat, alpha, delta, jd0
!!!    logical, intent(in) :: verbose
!!!    logical, intent(in) :: mags,fluxes,instrmag,fileprint!,full,positions,header,
!!!
!!!!    integer, parameter :: DIM = 7
!!!!    integer, dimension(DIM) :: naxes
!!!    integer :: status!,blocksize,naxis,pcount,gcount,bitpix,nrows,colnum
!!!!    character(len=10) :: colname
!!!!    logical :: simple,extend,anyf
!!!!    integer :: frow = 1, felem = 1
!!!!    real(dbl) :: nullval = 0.0
!!!
!!!    character(len=80) :: ctype,filter,dateobs
!!!    character(len=666) :: fmt = ""
!!!    character(len=80), dimension(:), allocatable :: headval, cols, fkeys
!!!!    character(len=80), dimension(:), allocatable :: cols
!!!    integer :: i,j,ij,n, ndata!,icol!,y1,m1,d1,h1,min1
!!!    real(dbl) :: year,month,day,hour,min,sec,exptime,jd,jd0, r,rmin,dt,tol,dtol,scale,angle 
!!!    !,hcor,helcor, ls,&
!!!    !         phase,azimut,elev,ha,airm,
!!!!    real(dbl),dimension(:), allocatable :: sky,dsky,x,y
!!!    real(dbl),dimension(:), allocatable :: x,y
!!!    real(dbl),dimension(:,:), allocatable :: data,xdata,xmag,xflux
!!!!    real(dbl),dimension(:,:), allocatable :: flux,dflux,xflux,xdflux
!!!!    integer, dimension(:), allocatable :: id
!!!    real(dbl), dimension(:), allocatable :: a,d,u,v,mag,dmag,flux,dflux
!!!!    real(dbl), dimension(:), allocatable :: xpix,ypix,csky,cdsky,cflux,cdflux,a,d,u,v,mag,dmag
!!!    real(dbl), dimension(2) :: crval, crpix!, crder
!!!!    real(dbl), dimension(2,2) :: cd
!!!    type(TypeProjection) :: t
!!!
!!!!    real :: e,x(nstars),dx(nstars),sky(nstars),dsky(nstars)
!!!!    real :: is(nstars),dis(nstars)
!!!
!!!!    tol = xtol
!!!!    n = size(idx) + size(xcoo)
!!!
!!!!    allocate(gfitskeys(size(fitskeys))
!!!!    if( allocated(gfitskeys) ) gfitskeys = fitskeys
!!!
!!!    n = size(xcoo)
!!!    if( mags .or. fluxes ) then
!!!       allocate(cols(2))
!!!       cols(1) = 'apflux'
!!!       cols(2) = 'apflux_err'
!!!       if( allocated(gdata) ) then
!!!          deallocate(gdata)
!!!          n = size(gdata,1)
!!!          allocate(gdata(n,2))
!!!       end if
!!!    else
!!!       allocate(cols(size(selcols)))
!!!       cols = selcols
!!!    end if
!!!
!!!    call table(filename, fitskeys, headkeys, cols, aperture, verbose, &
!!!         headval,year,month,day,hour,min,sec,exptime,filter,ctype,crpix,crval,scale,angle,dtol,&
!!!         x,y,data,status)
!!!    if( status /= 0 ) then
!!!       deallocate(cols)
!!!       if( allocated(headval) ) deallocate(headval)
!!!       if( allocated(x) ) deallocate(x)
!!!       if( allocated(y) ) deallocate(y)
!!!       if( allocated(data) ) deallocate(data)
!!!       return
!!!    end if
!!!
!!!    ! Evaluate Julian date at half of exposure 
!!!    jd = datjd(year,month,day + (hour + (min + sec/60.0)/60.0)/24.0)
!!!    jd = jd + exptime/2.0/86400.0
!!!
!!!!    write(*,*) jd
!!!
!!!    ! look for coordinates
!!!    n = size(xcoo)
!!!
!!!    if( n > 0 ) then
!!!
!!!       allocate(a(n),d(n),u(n),v(n))
!!!       do j = 1, n
!!!          dt = jd - jd0
!!!          a(j) = xcoo(j) + vxcoo(j)*dt
!!!          d(j) = ycoo(j) + vycoo(j)*dt
!!!       end do
!!!
!!!       t%type = ctype    
!!!       t%acen = crval(1)
!!!       t%dcen = crval(2)
!!!       t%xcen = crpix(1)
!!!       t%ycen = crpix(2)
!!!       t%scale = scale
!!!       t%pa = angle
!!!    
!!!       call trafo(t,a,d,u,v)
!!!       !    write(*,*) a,d,u,v
!!!
!!!       if( xtol > 0.0 ) then
!!!          tol = xtol
!!!       else
!!!          ! one looks strange, but 1pix is prefered over dtol=0.0
!!!          tol = 10.0*max(dtol,1.0/scale)
!!!       end if
!!!       tol = scale*tol
!!!       
!!!       ! locate stars on base of euclidean metric
!!!       ndata = size(cols)
!!!       allocate(xdata(n,ndata))
!!!       !    tol = max(,xtol)
!!!       !    write(*,*) tol,scale
!!!       do j = 1, n
!!!
!!!          rmin = huge(rmin)
!!!          ij = 0
!!!
!!!          do i = 1, size(x)
!!!             r = sqrt((x(i) - u(j))**2 + (y(i) - v(j))**2)
!!!             !          write(*,'(5f10.3)') x(i),u(j),y(i),v(j),r
!!!             if( r < tol .and. r < rmin) then
!!!                rmin = r
!!!                ij = i
!!!             end if
!!!          end do
!!!          
!!!          if( ij > 0 ) then
!!!             xdata(j,:) = data(ij,:)
!!!          else
!!!             xdata(j,:) = 0.0
!!!             if( verbose ) write(*,'(a,2(f0.5,1x),"(",2(f0.1,1x),"[pix]) ",a,g0.5)') &
!!!                  'Object at ',a(j),d(j),u(j),v(j),' not found: r=',r
!!!          end if
!!!       end do
!!!
!!!       deallocate(u,v)
!!!
!!!    else
!!!
!!!       n = size(x)
!!!       ndata = size(cols)
!!!       allocate(a(n),d(n),xdata(n,ndata))
!!!       xdata = data
!!!
!!!       t%type = ctype
!!!       t%acen = crval(1)
!!!       t%dcen = crval(2)
!!!       t%xcen = crpix(1)
!!!       t%ycen = crpix(2)
!!!       t%scale = scale
!!!       t%pa = angle
!!!       call invtrafo(t,x,y,a,d)
!!!       
!!!
!!!    end if
!!!
!!!
!!!    if( mode == 'lc' ) then
!!!
!!!
!!!
!!!!    if( mode == 'head' ) then
!!!
!!!!    write(*,707) int(year),int(month),int(day),int(hour),int(min),int(sec),&
!!!!         jd,(trim(headval(i)),i=1,size(headval))
!!!    
!!!!707 format (1x,i4.4,tr1,5(i2.2,tr1),f13.5,2000(1x,a))
!!!
!!!       ! save LC
!!!       if( allocated(gyear) ) then
!!!          gra = a(1)
!!!          gdec = d(1)
!!!
!!!          nfile = nfile + 1
!!!          gyear(nfile) = year
!!!          gmonth(nfile) = month
!!!          gday(nfile) = day
!!!          ghour(nfile) = hour
!!!          gminute(nfile) = min
!!!          gsec(nfile) = sec
!!!          gexposure(nfile) = exptime
!!!          gfilters(nfile) = filter
!!!          gjulday(nfile) = jd
!!!!          gdata(nfile,:) = xdata(1,:)
!!!!          write(*,*) nfile,gminute(nfile)
!!!
!!!       end if
!!!
!!!
!!!    if( mags ) then
!!!
!!!       allocate(mag(n),dmag(n))
!!!       call magnitudes(zeromag,xdata(:,1),xdata(:,2),mag,dmag)
!!!       write(fmt,'(a,i0,a)') "(1x,f0.10,1x,3a,1x,",2*n,"(1x,f0.5))"
!!!       if( instrmag ) then
!!!          write(*,fmt) jd,"'",trim(filter),"'",(mag(i),dmag(i),i=1,n)
!!!       else
!!!          write(*,fmt) jd,"'",trim(filter),"'", &
!!!               (mag(i)-mag(1),sqrt(dmag(i)**2+dmag(1)**2),i=2,n)
!!!       end if
!!!       gdata(nfile,:) = (/mag,dmag/)
!!!       deallocate(mag,dmag)
!!!
!!!    else if( fluxes ) then
!!!
!!!       allocate(flux(n),dflux(n))
!!!       flux = xdata(:,1)/exptime
!!!       dflux = xdata(:,2)/sqrt(exptime)
!!!!       call magnitudes(zeromag,xdata(:,1),xdata(:,2),mag,dmag)
!!!       write(fmt,'(a,i0,a)') "(1x,f0.10,1x,3a,1x,",2*n,"(1x,f0.5))"
!!!       write(*,fmt) jd,"'",trim(filter),"'",(flux(i),dflux(i),i=1,n)
!!!       gdata(nfile,:) = (/flux,dflux/)
!!!       deallocate(flux,dflux)
!!!
!!!    else 
!!!
!!!       if( fileprint ) write(*,'(3a)',advance="no") "'",trim(filename),"'"
!!!
!!!       write(*,'(1x,i4.4,tr1,4(i2.2,tr1),f6.3,tr1,f6.1,tr1,3a)',advance="no") &
!!!            int(year),int(month),int(day),int(hour),int(min),sec,exptime,"'",trim(filter),"'"
!!!
!!!       if( size(headval) > 0 ) &
!!!            write(*,'(1000a)',advance="no") (" '"//trim(headval(i))//"'",i=1,size(headval))
!!!       
!!!       write(*,"(tr2,f20.10)",advance="no" ) jd
!!!
!!!       if( cootype == 'horizontal' ) then
!!!
!!!!          if( alpha >= 0.0 .and. abs(lat) <= 90.0 )then
!!!!             ha = hangle(lmst(jd,long)*15.0_dbl,alpha)
!!!!             call eq2hor(ha,delta,lat,azimut,elev)
!!!!             airm = airmass(90.0_dbl-elev)
!!!!             write(*,'(2f10.5,f10.5)',advance="no") azimut,elev,airm
!!!!          end if
!!!
!!!       else if( cootype == 'pixels' ) then
!!!
!!!          write(*,'(2000f10.3)',advance="no") (xcoo(i),ycoo(i),i=1,n)
!!!!          write(*,'(2000f10.3)',advance="no") (u(i),v(i),i=1,n)
!!!          
!!!       else if( cootype == 'equatorial' ) then
!!!
!!!          call invtrafo(t,xcoo,ycoo,a,d)
!!!!          call invtrafo(t,u,v,a,d)
!!!          write(*,'(2000f12.5)',advance="no") (a(i),d(i),i=1,n)
!!!
!!!       end if
!!!
!!!       write(*,*) ((xdata(i,j),j=1,ndata),i = 1,n)
!!!
!!!       ! save LC
!!!       gdata(nfile,:) = xdata(1,:)
!!!
!!!!!$       if( allocated(gyear) ) then
!!!!!$          ra = a(1)
!!!!!$          dec = d(1)
!!!!!$
!!!!!$          nfile = nfile + 1
!!!!!$          gyear(nfile) = year
!!!!!$          gmonth(nfile) = month
!!!!!$          gday(nfile) = day
!!!!!$          ghour(nfile) = hour
!!!!!$          gminute(nfile) = min
!!!!!$          gsec(nfile) = sec
!!!!!$          gexposure(nfile) = exptime
!!!!!$          gfilters(nfile) = filter
!!!!!$          gjulday(nfile) = jd
!!!!!$          gdata(nfile,:) = xdata(1,:)
!!!!!$!          write(*,*) nfile,gminute(nfile)
!!!!!$
!!!!!$       end if
!!!
!!!!call storelc(a(1),d(1),2000.0_dbl,int(year),int(month),int(day),int(hour),int(min), &
!!!!            sec,exptime,jd,filter,xdata(1,:))
!!!
!!!    end if
!!!
!!!
!!!
!!! else if( mode == 'sc' ) then
!!!
!!!    if( mags ) then
!!!       allocate(mag(n),dmag(n))
!!!       call magnitudes(zeromag,xdata(:,1),xdata(:,2),mag,dmag)
!!!    else if( fluxes ) then
!!!       allocate(flux(n),dflux(n))
!!!       flux = xdata(:,1)/exptime
!!!       dflux = xdata(:,2)/sqrt(exptime)
!!!    end if
!!!
!!!    do i = 1,n
!!!
!!!       write(*,'(2(f0.7,1x))',advance="no") a(i),d(i)
!!!
!!!       if( mags ) then
!!!          write(*,"(2(f0.5,1x))") mag(i),dmag(i)
!!!       else if( fluxes ) then
!!!          write(*,"(2(en17.7,1x))") flux(i),dflux(i)
!!!       else
!!!          write(*,*) (xdata(i,j),j=1,ndata)
!!!       end if
!!!    end do
!!!
!!!    ! save star field
!!!    if( output /= '' ) then
!!!       i = 0
!!!       call fttm2s(int(year),int(month),int(day),int(hour),int(min),sec,3,dateobs,i)
!!!       if( mags ) then
!!!          allocate(xmag(size(mag),2))
!!!          xmag(:,1) = mag
!!!          xmag(:,2) = dmag
!!!          allocate(fkeys(2))
!!!          fkeys(1) = 'MAG'
!!!          fkeys(2) = 'MAG_ERR'
!!!          call savecat(output,filename,fitskeys,object,observer,author,instrument,telescope, &
!!!               origin,reference,equinox,dateobs,filter,exptime,fkeys,a,d,xmag)
!!!          deallocate(xmag,fkeys) 
!!!       else if( fluxes ) then
!!!          allocate(xflux(size(flux),2))
!!!          xflux(:,1) = flux
!!!          xflux(:,2) = dflux
!!!          allocate(fkeys(2))
!!!          fkeys(1) = 'FLUX'
!!!          fkeys(2) = 'FLUX_ERR'
!!!          call savecat(output,filename,fitskeys,object,observer,author,instrument,telescope, &
!!!               origin,reference,equinox,dateobs,filter,exptime,fkeys,a,d,xflux)
!!!          deallocate(xflux,fkeys)
!!!       else
!!!          call savecat(output,filename,fitskeys,object,observer,author,instrument,telescope, &
!!!               origin,reference,equinox,dateobs,filter,exptime,cols,a,d,xdata)
!!!       end if
!!!    end if
!!!
!!!    if( mags ) deallocate(mag,dmag)
!!!    if( fluxes ) deallocate(flux,dflux)
!!!
!!! end if
!!!
!!!
!!!!    else if( mode == 'pos' ) then
!!!
!!!!       write(*,704) int(year),int(month),int(day),int(hour),int(min),int(sec), &
!!!!            jd, (xrect(i),yrect(i),i = 1,n)
!!!!704    format (1x,i4.4,tr1,5(i2.2,tr1),tr2,f13.5,1x, 10000f10.3)
!!!          
!!!
!!!
!!!!    else
!!!
!!!!       write(*,700) int(year),int(month),int(day),int(hour),int(min),int(sec), !&
!!!!            exptime,filter,jd, (flux(i),dflux(i),i = 1,n)
!!!!700    format (1x,i4.4,tr1,5(i2.2,tr1),f6.1,tr1,a1,tr2,f13.5,1x, 10000(es15.6,es9.2))
!!!
!!!!       write(*,*) trim(filename),int(year),int(month),int(day),int(hour),int(min),int(sec),&
!!!!            jd,(sky(i),dsky(i),flux(i),dflux(i),i = 1,n)
!!!
!!!!    end if
!!!
!!!
!!! !   if( header ) then
!!!
!!!
!!!
!!!    ! output relative quantities
!!!  !  else if( relative ) then
!!!       
!!!
!!!   ! else 
!!!       ! instrumental fluxes
!!!       
!!!!!$       if( full ) then
!!!!!$
!!!!!$          if( alpha >= 0.0 .and. abs(lat) <= 90.0 )then
!!!!!$             ha = hangle(lmst(jd,long)*15.0_dbl,alpha)
!!!!!$             call eq2hor(ha,delta,lat,azimut,elev)
!!!!!$             airm = airmass(90.0_dbl-elev)
!!!!!$             write(*,701) int(year),int(month),int(day),int(hour),int(min), &
!!!!!$                  int(sec),exptime,filter,jd,azimut,elev,airm, &
!!!!!$                  (sky(i),dsky(i),flux(i),dflux(i),i = 1,n)
!!!!!$          else
!!!!!$!             write(*,*) n,sky,flux,dsky,dflux
!!!!!$             write(*,701) int(year),int(month),int(day),int(hour),int(min), &
!!!!!$                  int(sec),exptime,filter,jd,(sky(i),dsky(i),flux(i),dflux(i),i = 1,n)
!!!!!$          endif
!!!!!$701       format (1x,i4.4,tr1,5(i2.2,tr1),f6.1,tr1,a1,tr2,f13.5,1x, 1p, 1000g12.6)
!!!!!$
!!!!!$       else if( positions .and. n > 0 ) then
!!!!!$
!!!!!$
!!!!!$       else
!!!!!$
!!!!!$
!!!!!$
!!!!!$       end if
!!!!!$
!!!
!!!
!!!!    end if
!!!
!!!    deallocate(a,d,x,y,cols,headval,xdata,data)
!!!
!!!  end subroutine munilist
!!!
