!
!  listing of derived quantities extracted from calibrated images
!
!  Copyright © 2011-2, 2016 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/>.


program list

  use mlist

  implicit none
  
  integer, parameter :: dbl = selected_real_kind(15)
  integer, parameter :: clen = 32768
  character(len=clen) :: mode,filename,ifile,line,record,output,backup
!  character(len=9) :: dateobs = 'DATE-OBS',timeobs = 'TIME-OBS', exptime = 'EXPTIME', &
!       filter = 'FILTER'
!  character(len=80) :: object,observer,author,instrument,telescope,origin,reference
  character(len=80) :: column = 'apcount1', key, cootype = ''
!  character(len=10), dimension(35) :: columns
  ! the len is determined by TFORM, the dimension same as in muniphot/ifits
  real(dbl), dimension(:), allocatable :: xcoo, ycoo, vxcoo, vycoo
  character(len=80), dimension(:), allocatable :: fitskeys,headkeys, cols
!  integer, dimension(:), allocatable :: idx
  real(dbl) :: tol = -1.0, aperture = 2.0, &
       zeromag = 25.0_dbl, flux0=1e-26,  x, y, vx, vy, jd0, equinox, &
       long, lat = -99.9, alpha = -1.0, delta, min0, per = -1.0
       
!       zeromag = 25.0_dbl, min0, per = -1.0, x, y, vx, vy, jd0, equinox
  logical :: calibr = .false., mags = .false., fluxes = .false., fileprint = .false.
  !full = .false., &
!       positions = .false., header = .false., 
  logical :: verbose = .false., diffmag = .false.
!  integer :: i,eq,cc,istat,quiet=0,ncoo,nidx,nkeys !,ncolumns
  integer :: eq,cc,istat,ncoo,nkeys,ncols,nfile,naperture !nidx,,ncolumns

  mode = 'lc'
  equinox = 2000.0_dbl
!  ncolumns = 0
!  ncols = 0
  ncoo = 0
!  nidx = 0
  nkeys = 0
!  ncols = 0
!  allocate(cols(0))
  ncols = 2
  allocate(cols(2))
  cols(1) = 'apcount'
  cols(2) = 'apcount_err'

  allocate(headkeys(0))
!  allocate(xcoo(0),ycoo(0),vxcoo(0),vycoo(0))
  allocate(fitskeys(17))
  fitskeys(1) = FITS_KEY_DATEOBS
  fitskeys(2) = FITS_KEY_TIME
  fitskeys(3) = FITS_KEY_EXPTIME
  fitskeys(4) = FITS_KEY_FILTER
  fitskeys(5) = 'EQUINOX'
  fitskeys(6) = 'OBJECT'
  fitskeys(7) = 'OBSERVER'
  fitskeys(8) = 'AUTHOR'
  fitskeys(9) = 'INSTRUME'
  fitskeys(10) = 'TELESCOP'
  fitskeys(11) = 'ORIGIN'
  fitskeys(12) = 'BIBREF'
  fitskeys(13) = 'AREA'
  fitskeys(14) = 'CTFLUX'
  fitskeys(15) = 'CTFLUXER'
  fitskeys(16) = 'CTAPER'
  fitskeys(17) = 'ZEROFLUX'


  do
     read(*,'(a)',end=99,iostat=istat) record
     if( istat /= 0 ) then
        write(*,*) 'Unexpected string on input.'
        stop 21
     end if

     cc = index(record,'#')
     if( cc == 0 ) then
        line = record
     else
        line = record(1:cc-1)
     end if

     eq = index(line,'=')

     if( index(line,'OUTPUT') > 0 .and. eq > 0) then
        
        read(line(eq+1:),*,iostat=istat) output,backup
        if( istat /= 0 ) then
           write(*,*) 'OUTPUT parameter read failed.'
           stop 21
        end if

     else if( index(line,'VERBOSE') > 0 .and. eq > 0) then

        read(line(eq+1:),*,iostat=istat) verbose
        if( istat /= 0 ) then
           write(*,*) 'VERBOSE parameter read failed.'
           stop 21
        end if

     else if( index(line,'MODE') > 0 .and. eq > 0) then
        
        read(line(eq+1:),*,iostat=istat) mode
        if( istat /= 0 ) then
           write(*,*) 'MODE parameter read failed.'
           stop 21
        end if

     else if( index(line,'COOTYPE') > 0 .and. eq > 0) then
        
        read(line(eq+1:),*) cootype

     else if( index(line,'NKEYWORDS') > 0 .and. eq > 0) then

        read(line(eq+1:),*) nkeys
        deallocate(headkeys)
        allocate(headkeys(nkeys))
        nkeys = 0

     else if( index(line,'KEYWORDS') > 0 .and. eq > 0) then

        read(line(eq+1:),*,iostat=istat) key
        if( istat /= 0 ) then
           write(*,*) 'KEYWORD parameter read failed.'
           stop 21
        end if

!        if( nkeys == size(hkeys) ) then
!           call reallocate(hkeys,size(hkeys)+memstep)
!        end if

        if( allocated(headkeys) .and. nkeys < size(headkeys) ) then
           nkeys =  nkeys + 1
           headkeys(nkeys) = key
        end if

     else if( index(line,'NCOLUMNS') > 0 .and. eq > 0) then

        read(line(eq+1:),*) ncols
        deallocate(cols)
        allocate(cols(ncols))
        ncols = 0

     else if( index(line,'COLUMNS') > 0 .and. eq > 0) then

        read(line(eq+1:),*,iostat=istat) column
        if( istat /= 0 ) then
           write(*,*) 'COLUMN parameter read failed.'
           stop 21
        end if
        
        if( allocated(cols) .and. ncols < size(cols) ) then
           ncols = ncols + 1
           cols(ncols) = column
        end if

!!$     else if( index(line,'NINDEX') > 0 .and. eq > 0) then
!!$
!!$        read(line(eq+1:),*) nidx
!!$        allocate(idx(nidx))
!!$        nidx = 0
!!$
!!$     else if( index(line,'INDEX') > 0 .and. eq > 0 )  then
!!$
!!$        read(line(eq+1:),*,iostat=istat) i
!!$        if( istat /= 0 ) then
!!$           write(*,*) 'INDEX parameter read failed.'
!!$           stop 21
!!$        end if
!!$
!!$        if( allocated(idx) .and. nidx < size(idx) ) then
!!$           nidx =  nidx + 1
!!$           idx(nidx) = i
!!$!           call reallocate(idx,size(idx)+memstep)
!!$        end if

     else if( (index(line,'NCARTESIAN') > 0 &
          .or. index(line,'NSPHERICAL') > 0) .and. eq > 0) then


!        write(*,*) trim(line),allocated(xcoo),ncoo,size(xcoo)
        read(line(eq+1:),*) ncoo
!        deallocate(xcoo,ycoo,vxcoo,vycoo)
        allocate(xcoo(ncoo),ycoo(ncoo),vxcoo(ncoo),vycoo(ncoo))
        ncoo = 0
        vxcoo = 0.0_dbl
        vycoo = 0.0_dbl
!        write(*,*) trim(line),allocated(xcoo),ncoo,size(xcoo)

     else if( (index(line,'CARTESIAN') > 0 &
          .or. index(line,'SPHERICAL') > 0) .and. eq > 0) then

!        write(*,*) trim(line),allocated(xcoo),ncoo,size(xcoo)

        read(line(eq+1:),*,iostat=istat) x,y,vx,vy
        if( istat /= 0 ) then
           write(*,*) 'Coordinates parameter read failed.'
           stop 21
        end if

!        if( ncoo == size(xcoo) ) then
!           call reallocate(xcoo,size(xcoo)+memstep)
!           call reallocate(ycoo,size(ycoo)+memstep)
!           call reallocate(vxcoo,size(vxcoo)+memstep)
!           call reallocate(vycoo,size(vycoo)+memstep)
!        end if
        
        if( allocated(xcoo) .and. ncoo < size(xcoo) ) then

!           write(*,*) ncoo,size(xcoo),x,y
           ncoo =  ncoo + 1
           xcoo(ncoo) = x
           ycoo(ncoo) = y
           vxcoo(ncoo) = vx
           vycoo(ncoo) = vy

           if( index(line,'CARTESIAN') > 0 ) cootype = 'pixels'
        end if

     else if( index(line,'TOL') > 0 .and. eq > 0) then

        read(line(eq+1:),*,iostat=istat) tol
        if( istat /= 0 ) then
           write(*,*) 'TOL parameter read failed.'
           stop 21
        end if

     else if( index(line,'JD0') > 0 .and. eq > 0) then

        read(line(eq+1:),*,iostat=istat) jd0
        if( istat /= 0 ) then
           write(*,*) 'JD0 parameter read failed.'
           stop 21
        end if

!     else if( index(line,'MRECT') > 0 .and. eq > 0) then
!
!        read(line(eq+1:),*,iostat=istat) x,y
!        if( istat /= 0 ) then
!           write(*,*) 'MRECT parameter read failed.'
!           stop 21
!        end if
!
!        if( ncoo == size(xcoo) ) then
!           call reallocate(xcoo,size(xcoo)+memstep)
!           call reallocate(ycoo,size(ycoo)+memstep)
!        end if
!
!        mcoo =  mcoo + 1
!        mcoo(mcoo) = x;
!        mcoo(mcoo) = y;
!

!     else if( index(line,'HEADER') > 0 .and. eq > 0) then

!        header = .true.

!     else if( index(line,'MAG') > 0 .and. eq > 0) then

!        mag = .true.

!     else if( index(line,'RELATIVE') > 0 .and. eq > 0) then

!        read(line(eq+1:),*,iostat=istat) relative
!        if( istat /= 0 ) then
!           write(*,*) 'RELATIVE parameter read failed.'
!           stop 21
!        end if

!     else if( index(line,'FULL_LISTING') > 0 .and. eq > 0) then

!        full = .true.
!        relative = .false.

!     else if( index(line,'POSITION_LISTING') > 0 .and. eq > 0) then

!        positions = .true.
!        relative = .false.

!     else if( index(line,'DEBUG') > 0 .and. eq > 0) then

!        read(line(eq+1:),*,iostat=istat) quiet
!        if( istat /= 0 ) then
!           write(*,*) 'DEBUG parameter read failed.'
!           stop 21
!        end if

     else if( index(line,'MAGNITUDES') > 0 .and. eq > 0) then

        read(line(eq+1:),*) mags

     else if( index(line,'FLUXES') > 0 .and. eq > 0) then

        read(line(eq+1:),*) fluxes

     else if( index(line,'CALIBRATED') > 0 .and. eq > 0) then

        read(line(eq+1:),*) calibr

     else if( index(line,'DIFFMAG') > 0 .and. eq > 0) then

        read(line(eq+1:),*) diffmag

     else if( index(line,'ZEROMAG') > 0 .and. eq > 0) then

        read(line(eq+1:),*) zeromag

     else if( index(line,'PHOTFLUX') > 0 .and. eq > 0) then

        read(line(eq+1:),*) flux0

     else if( index(line,'APERTURE') > 0 .and. eq > 0) then

        read(line(eq+1:),*) aperture

     else if( line(:eq-1) == 'NAPERTURE' ) then

        read(line(eq+1:),*) naperture

!!$     else if( index(line,'LATITUDE') > 0 .and. eq > 0) then
!!$
!!$        read(line(eq+1:),*,iostat=istat) lat
!!$        if( istat /= 0 ) then
!!$           write(*,*) 'GEOGRAPHICAL parameter read failed.'
!!$           stop 21
!!$        end if
!!$
!!$     else if( index(line,'LONGITUDE') > 0 .and. eq > 0) then
!!$
!!$        read(line(eq+1:),*,iostat=istat) long
!!$        if( istat /= 0 ) then
!!$           write(*,*) 'GEOGRAPHICAL parameter read failed.'
!!$           stop 21
!!$        end if
!!$
!!$     else if( index(line,'ALPHA') > 0 .and. eq > 0) then
!!$
!!$        read(line(eq+1:),*,iostat=istat) alpha
!!$        if( istat /= 0 ) then
!!$           write(*,*) 'EQUATORIAL parameter read failed.'
!!$           stop 21
!!$        end if
!!$
!!$     else if( index(line,'DELTA') > 0 .and. eq > 0) then
!!$
!!$        read(line(eq+1:),*,iostat=istat) delta
!!$        if( istat /= 0 ) then
!!$           write(*,*) 'EQUATORIAL parameter read failed.'
!!$           stop 21
!!$        end if

!!$     else if( index(line,'EPOCH') > 0 .and. eq > 0) then
!!$
!!$        read(line(eq+1:),*,iostat=istat) min0
!!$        if( istat /= 0 ) then
!!$           write(*,*) 'LC_ELEMENTS parameter read failed.'
!!$           stop 21
!!$        end if

!!$     else if( index(line,'PERIOD') > 0 .and. eq > 0) then
!!$
!!$        read(line(eq+1:),*,iostat=istat) per
!!$        if( istat /= 0 ) then
!!$           write(*,*) 'LC_ELEMENTS parameter read failed.'
!!$           stop 21
!!$        end if

     else if( index(line,'DATE-OBS') > 0 .and. eq > 0 ) then
        read(line(eq+1:),*) fitskeys(1)!dateobs

     else if( index(line,'TIME-OBS') > 0 .and. eq > 0 ) then
        read(line(eq+1:),*) fitskeys(2)!timeobs

     else if( index(line,'EXPTIME') > 0 .and. eq > 0 ) then
        read(line(eq+1:),*) fitskeys(3)!exptime

     else if( index(line,'FILTER') > 0 .and. eq > 0 ) then
        read(line(eq+1:),*) fitskeys(4)!filter

!     else if( index(line,'EXTNAME') > 0 .and. eq > 0 ) then
!        read(line(eq+1:),*) extname

     else if( index(line,'PRINT_FILENAME') > 0 .and. eq > 0) then

        read(line(eq+1:),*) fileprint

     else if( index(line,'NFILES') > 0 .and. eq > 0) then

        read(line(eq+1:),*) nfile

        if( mode == 'cat' .and. nfile /= 1 ) &
             stop 'Passing many files uncompatible to catalogue list. Single file expected.'
!        if( size(headkeys) /= nkeys ) stop "Count of set and passed fits keys does not match."
!        if( size(xcoo) /= ncoo ) stop "Count of set and passed coordinates does not match."

        if( mags .or. fluxes ) then
           if( allocated(cols)) deallocate(cols)
           ncols = 2
           allocate(cols(2))
           cols(1) = 'apcount'
           cols(2) = 'apcount_err'
        end if

        call munilist_init(mode,nfile,fitskeys,headkeys,cols,aperture,naperture, &
             tol,zeromag,flux0,jd0,equinox,mags,fluxes,calibr,diffmag,verbose,fileprint)

        if( allocated(xcoo) ) call munilist_coo(cootype,xcoo,ycoo,vxcoo,vycoo)

     else if( index(line,'FILE') > 0 .and. eq > 0) then

        read(line(eq+1:),*,iostat=istat) filename
        if( istat /=0 ) then
           write(*,*) 'Invalid filename format.'
           stop 21
        end if

!        if( .not. allocated(headkeys) ) allocate(headkeys(0))
!        if( .not. allocated(cols) ) allocate(cols(0))
!        if( .not. allocated(idx) ) allocate(idx(0))
!        if( .not. allocated(xcoo) ) allocate(xcoo(0),ycoo(0),vxcoo(0),vycoo(0))


        call munilist_add(filename)
!!$        call munilist(mode,filename,output,aperture,&!idx(:nidx), &
!!$!        call munilist(mode,filename,output,column,idx(:nidx), &
!!$!        call munilist(mode,filename,output,idx(:nidx), &
!!$             xcoo(:ncoo),ycoo(:ncoo),vxcoo(:ncoo),vycoo(:ncoo),tol, &
!!$             zeromag,jd0,&
!!$        !min0,per,long,lat,alpha,delta,jd0,
!!$             mags,fluxes,instrmag, &!full,positions, &
!!$        !     header,
!!$        verbose,fileprint,cootype,keys(1:nkeys),cols,(/dateobs,timeobs,exptime,filter/),&
!!$        object,observer,author,instrument,telescope,origin,reference,equinox)

     end if

  end do
99 continue

  call munilist_finish(output,backup)

!  if( allocated(idx)  ) deallocate(idx)
  deallocate(fitskeys)
  if( allocated(headkeys) ) deallocate(headkeys)
  if( allocated(cols) ) deallocate(cols)
  if( allocated(xcoo) ) deallocate(xcoo,ycoo,vxcoo,vycoo)

  stop 0

end program list
