!
!     PHOTOMETRY, aperture photometry
!     Copyright (C) 1997-9,2010,2013-17 Filip Hroch, Masaryk University
!     Copyright (C) 1991 P.B. Stetson, Dominon Astrophysical Observatory
!
!
!  This file is part of Munipack.
!
!  Credits
!
!    Almost all this source is authored by P. B. Stetson.
!    I adapted it for Fortran 90 (allocatable arrays, precision,
!    array syntax), corrected errors, improve sky estimate by
!    variance stabilising estimator.
!
!
!  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 mdaofotometr

contains

subroutine  daophotsb (d, stderr,xstar,ystar,hstar,raper,ring,lobad,hibad,phpadu, &
     verbose,plog,apcts,apcts_err,xsky,xsky_err,status)

!watch, coofil, magfil)
  use iso_fortran_env
  use robustmean
  use weightedmean
  use medians

  implicit none

  real, dimension(:,:), intent(in) :: d,stderr
  real, dimension(:), intent(in) :: xstar, ystar, hstar, raper,ring
  real, dimension(:,:), intent(out) :: apcts,apcts_err
  real, dimension(:), intent(out) :: xsky,xsky_err
  real, intent(in) :: lobad, hibad, phpadu
  logical, intent(in) :: verbose, plog
  integer, intent(out) :: status

!
!=======================================================================
!
! This subroutine derives the concentric aperture photometry.  At
! present, this is the only place in all of DAOPHOT where sky values
! are derived for the individual stars.
!
!               OFFICIAL DAO VERSION:  1991 April 18
!
! Argument
!
!    WATCH (INPUT) governs whether information relating to the progress
!          of the reductions is to be typed on the terminal screen
!          during execution.
!
!=======================================================================
!
!!!  implicit none
!!!  integer :: ncol, nrow
!!!  real :: d(ncol, nrow)
  integer, parameter :: precision = selected_real_kind(14)

  integer, parameter  :: minsky = 20!, maxap = 12
  real, parameter :: pi = 3.141592653589793115997963

!!!  character(len=*) :: coofil, magfil
!
! Parameters:
!
! MINSKY is the smallest number of pixels from which the sky may be
!        determined.  If for some star the number of sky pixels
!        is less than MINSKY, an error code will result and
!        control will return to the main program.
!
! MAXSKY the maximum number of pixels allowed in the sky annulus.
!        This and the user's requested inner sky radius will later
!        determine the maximum permitted outer sky radius.
!
! MAXAP  the maximum number of star apertures allowed.
!
  real(precision) :: maglim, magsq, wt, sumwt
  real(precision) :: apmag(size(raper)), area(size(raper)), sdev(size(raper))
!!!  real(precision) :: apmag(maxap), area(maxap)
  real, dimension(:), allocatable :: sky, dsky
  real :: error(3), magerr(size(raper)) !magerr(maxap)
!!!  real :: par(maxap+2) = 0.0
!!!  real :: pmin(maxap+2) = tiny(0.0)
!!!  real :: pmax(maxap+2) = huge(1.0)
!!!  real :: lobad, skymod, skysig, skyskw, sigsq, skyvar, skymn, skymed
  real :: skymod, skysig, skyskw, sigsq, skyvar, skyerr!, skymn, skymed
  real :: datum, r, rsq, fractn, edge!, thresh!, dum
!!!  real :: datum, r, rsq, fractn, edge, hibad, thresh, dum
  real :: readns, xc, yc, dmag, apmxsq
!!!  real :: phpadu, readns, xc, yc, dmag, watch, apmxsq
  real :: rinsq, rout, routsq, dysq
!  integer :: i, j, k, l, n, naper, idum, nmag, lx, ly, nx, ny
  integer :: i, j, k, n, naper, nmag, lx, ly, nx, ny
!  integer :: istar, mx, my, nsky, nl, maxsky, ncol, nrow
  integer :: istar, mx, my, nsky, maxsky, ncol, nrow
  logical :: reliable

  status = 0

!!!  character(len=10) :: table = 'mphoto.opt'
!!!  character(len=26) :: lbl(maxap+2) = (/ &
!!!              ' A1  RADIUS OF APERTURE  1',  &
!!!              ' A2  RADIUS OF APERTURE  2',   &
!!!              ' A3  RADIUS OF APERTURE  3',   &
!!!              ' A4  RADIUS OF APERTURE  4',   &
!!!              ' A5  RADIUS OF APERTURE  5',   &
!!!              ' A6  RADIUS OF APERTURE  6',   &
!!!              ' A7  RADIUS OF APERTURE  7',   &
!!!              ' A8  RADIUS OF APERTURE  8',   &
!!!              ' A9  RADIUS OF APERTURE  9',   &
!!!              ' AA  RADIUS OF APERTURE 10',   &
!!!              ' AB  RADIUS OF APERTURE 11',   &
!!!              ' AC  RADIUS OF APERTURE 12',   &
!!!              ' IS       INNER SKY RADIUS',   &
!!!              ' OS       OUTER SKY RADIUS'/)
!!!!

  ncol = size(d,1)
  nrow = size(d,2)
!  watch = 0.0
  skyskw = 0.0

!-----------------------------------------------------------------------
!
! SECTION 1
!
! Ascertain the name of the aperture photometry parameter table, and
! read it in.  Then set up all necessary variables for the forthcoming
! reductions. Finally, identify and open the input and output files.
!
!!!  l = maxap + 1
!!!  pmin(l) = 1.0
!!!
!!!  call getopt(table, maxap+2, par, pmin, pmax, istat)
!!!  if( istat /= 0 )then
!!!     write(*,*) 'Error during read apertures radii. Using following values: '
!!!     do i = 1, maxap + 2
!!!        write(*,"(a,f10.2)") lbl(i),par(i)
!!!     enddo
!!!  endif
!!!
!!!! check apertures?

!
! Count up the number of apertures that will be used.  The first zero or
! negative number encountered terminates the list.
!
!!!  naper = maxap
!!!  apmxsq = -1.0
!!!  do  i = 1, maxap
!!!     if (par(i) <= 0.0 ) then
!!!        naper = i - 1
!!!        exit
!!!     endif
!!!     apmxsq = max(apmxsq, (par(i)+0.5)**2)
!!!  enddo
!!!
  naper = size(raper)
  apmxsq = -1.0
  do i = 1, naper
     apmxsq = max(apmxsq, (raper(i)+0.5)**2)
  end do

!
! sky buffer allocation
!
!!!  maxsky = int(max(Pi*((par(maxap+2)+1)**2 - par(maxap+1)**2),1.5))
!!!  allocate(sky(maxsky))

  maxsky = int(max(pi*((ring(2)+1)**2 - ring(1)**2),1.5))
  allocate(sky(maxsky),dsky(maxsky))

!
! NAPER   is the number of apertures, whose radii are stored in
!         elements 1 through NAPER of the array PAR.
!
! APMXSQ  is the outermost edge of the largest aperture-- if the
!         distance squared of the center of a pixel from the centroid of
!         the star is greater than APMXSQ, then we know that no part
!         of the pixel is to be included in any aperture.
!
! Now define the other variables whose values are in the table.
!
!!!  rinsq = max(par(maxap + 1), 0.0)**2      ! Inner sky radius squared
  rinsq = max(ring(1), 0.0)**2      ! Inner sky radius squared
!!$  routsq = maxsky/pi + rinsq
!!$!!!  dum = par(maxap + 2)**2
!!$  dum = ring(2)**2
!!$  if (dum > routsq) then
!!$!!!    call stupid('   *** You have specified too big a sky annulus. ***')
!!$     write (error_unit,"(F10.2,A)") sqrt(routsq), &
!!$          ' pixels is the largest outer sky radius currently permitted.'
!!$     write (error_unit,*) '   *** You have specified too big a sky annulus. ***'
!!$     goto 666
!!$  else if (dum <= rinsq) then
!!$!!!     call stupid ('Your outer sky radius is no bigger than the inner radius.')
!!$!     write (error_unit,*) ' Please try again.'
!!$     write (error_unit,*) 'Your outer sky radius is no bigger than the inner radius.'
!!$     goto 666
!!$!     return
!!$  else
!!$  !!!   rout = par(maxap + 2)
!!$     rout = ring(2)
!!$     routsq = dum
!!$  end if
  rout = ring(2)
  routsq = ring(2)**2

!
! Inquire the name of the input data file with the stellar positions,
! and open it.
!
!!!  call infile (2, coofil, istat)
!!!  if (istat /= 0) then
!!!     call stupid ('Error opening input file '//coofil)
!!!     return
!!!  end if
!!!  call rdhead(2, nl, idum, idum, lobad, hibad, thresh, dum, phpadu, readns, dum)
!!!  if (nl < 1) nl = 1
!!!!
! Inquire file name for output aperture photometry results, and open
! the new file.
!
!!!  call outfil (3, magfil, istat)
!!!  if (istat /= 0) then
!!!     call stupid ('Error opening output file '//magfil)
!!!     return
!!!  end if
!!!  call wrhead (3, 2, ncol, nrow, 6, lobad, hibad, thresh, par(1), phpadu, readns, 0.)
!!!  readns = readns**2

! readns is unused ?????


!!!!
! If progress is being monitored, type out column headers.
!
!  if (watch > 0.5) &
  if( verbose ) &
       write (*,"(/13X, 'STAR', 5X, 'X', 7X, 'Y', 9X, 'MAG.(1)', 8X, 'SKY')")
!
! Initialize variables for the computation of the magnitude limit.
!
  maglim = 0.0
  magsq = 0.0
  sumwt = 0.0
  nmag = 0
!
!-----------------------------------------------------------------------
!
! SECTION 2
!
! Derive aperture photometry object by object.
!
! Get the coordinates of next object to be measured.
!
  lx = 1
  ly = 1
  nx = ncol
  ny = nrow

  do n = 1, size(xstar)

     xc = xstar(n)
     yc = ystar(n)
     dmag = -2.5*log10(hstar(n))
     istar = n

!!!!     call rdstar (2, nl, istar, xc, yc, dmag, dum)
!!!!     if (istar < 0) exit
!      if (istar == 0) go to 2000
!
! Compute the limits of the submatrix.
!
     lx = max(1, int(xc-rout)+1)
     mx = min(ncol, int(xc+rout))
     ly = max(1, int(yc-rout)+1)
     my = min(nrow, int(yc+rout))
     edge = min(xc-0.5, (ncol+0.5)-xc, yc-0.5, (nrow+0.5)-yc)
!     write(*,*) lx,mx,ly,my,edge,xc,rout,lobad,hibad
!
! EDGE is the distance of the star's centroid from the outermost
! extremum of the array.
!
! Initialize star counts and aperture area.
!
     do  i = 1, naper
        apmag(i) = 0.0
!
! If this star aperture extends outside the array, the magnitude
! in this aperture will be no good.
!
!!!!        if (edge < par(i)) apmag(i) = - huge(1.0)! Null magnitude
        if (edge < raper(i)) apmag(i) = - huge(1.0)  ! Null magnitude
        area(i) = 0.0
     enddo
     sdev = 0
!
! Now read through the submatrix, picking out the data we want.
!
     nsky = 0
!
     do  j = ly, my
        dysq = (j - yc)**2
!
        do i = lx,mx
           rsq = dysq + (i - xc)**2
           datum = d(i,j)
!
! Is this pixel within the sky annulus?
!
!           write(*,*) rsq,rinsq,routsq,datum,lobad,hibad
           if ( .not.((rsq < rinsq) .or. (rsq > routsq) .or. &
                (nsky > maxsky) .or. (datum < lobad) .or. &
                (datum > hibad))) then
              nsky = nsky + 1
              sky(nsky) = datum
              dsky(nsky) = stderr(i,j)
           endif
!
! The inclusion of partial pixels inside the aperture is done as
! follows:  if the distance of the center of the current pixel from the
! centroid of the star [radius vector r(i,j)] is exactly equal to the
! radius of the aperture [R(k)], then one-half of the counts in the
! pixel are included.  If r(i,j) < R(k)-0.5, then the entire pixel is
! included, while if r(i,j) > R(k)+0.5, the pixel is wholly excluded.
! In between, viz. for  R(k)-0.5 < r(i,j) < R(k)+0.5, the fraction of
! the counts included varies linearly.  Therefore a circular aperture
! is approximated by an irregular (not even convex) polygon.
!
! If this pixel falls completely outside the LARGEST aperture, go on
! to the next pixel.  Notice that APMXSQ has actually been defined
! as (R(k)+0.5)**2 for the largest value of R(k), in accordance with
! the formula used for the partial pixels.
!
           if (rsq <= apmxsq) then
              r = sqrt(rsq) - 0.5
!
              do k = 1, naper
!
! if this pixel falls completely outside THIS aperture, go on to the
! next aperture.
!
!!!!                 if (r <= par(k)) then
!!!!                    fractn = max(0.0, min(1.0,par(k) - r))
                 if (r <= raper(k)) then
                    fractn = max(0.0, min(1.0,raper(k) - r))
!
! fractn is the fraction of the pixel that falls inside the
! (irregular) aperture.
!
! If the pixel is bad, set the total counts in this aperture to a number
! so negative that it will never be positive again.
!                                                          ! Null magnitude
                    if (datum < lobad .or. datum > hibad ) apmag(k) = - huge(1.0)
                    apmag(k) = apmag(k) + fractn*datum
                    area(k) = area(k) + fractn
                    sdev(k) = sdev(k) + fractn * stderr(i,j)**2
                 endif
              enddo
           endif
        enddo ! i
!
   enddo ! j
!
! We have accumulated the brightnesses of individual sky pixels in the
! one-dimensional array SKY.  Pixels falling above or below the BAD
! limits have already been eliminated.  Now sort SKY to place the
! pixels in order of increasing brightness.
!
!   write(*,*) nsky,minsky,lobad,hibad

   if (nsky < minsky)  then
!      write(*,*) nsky,n,xc,yc
!!!      call stupid ('There aren''t enough pixels in the sky annulus.')
      write(error_unit,*) 'Object at coordinates:',xc,yc
      write(error_unit,*) ' Are you sure your bad pixel thresholds are all right?'
      write(error_unit,*) ' If so, then you need a larger outer sky radius.'
      write(error_unit,*) nsky,minsky,maxsky,lobad,hibad
      write(error_unit,*) 'There aren''t enough pixels in the sky annulus.'
!      stop
!      call tblank
!      call clfile (2)
!      call clfile (3)
!      return
      goto 3333
   end if
!      call quick (sky, nsky, index)
!
! Obtain the mode, standard deviation, and skewness of the peak in the
! sky histogram.
!
!      call mmm (sky, nsky, hibad, dum, datum, skymod, skysig, skyskw)
!!!   call robustmean1(sky, nsky, skymn, skymed, skymod, skysig, skyskw)

   if( all(sky(1:nsky) > 0) .and. all(dsky(1:nsky) > 0) ) then
      call rwmean(sky(1:nsky),dsky(1:nsky),skymod,skyerr,skysig,&
           reliable=reliable)
      !   write(*,*) nsky,skymod,skyerr,skysig
   else
      reliable = .false.
   end if
   if( .not. reliable ) then
      call rmean(sky(1:nsky),skymod,skyerr,skysig)
!      write(*,*) skymod,skysig
   end if

   skyvar=skysig**2
   sigsq=skyvar/nsky

!
! SKYMOD has units of (ADU/pixel), and SKYSIG is the pixel-to-pixel
! scatter of SKYMOD, in units of (ADU/pixel).  SKYVAR is the
! variance (square of the standard deviation) of the sky brightness,
! (ADU/pixel)**2, and SIGSQ is the square of the standard error of the
! mean sky brightness.
!
! Subtract the sky from the integrated brightnesses in the apertures,
! convert the results to magnitudes, and compute standard errors.
!
   do i = 1, naper
!
! If the modal sky value could not be determined, set the magnitude
! to 99.999.
!

      if (skysig < -0.5) go to 2210
      apmag(i) = apmag(i) - skymod*area(i)
!
! If the star + sky is fainter than the sky, or if the star aperture
! extends beyond the limits of the picture, or if there is a bad pixel
! in the star aperture, set the magnitude to 99.999.
!
      if (apmag(i) <= 0.0) go to 2210
!      error(1) = real(area(i)*skyvar)
      error(1) = real(area(i)*skyerr**2)
      error(2) = real(apmag(i))!*phpadu!/phpadu
      error(3) = real(sigsq*area(i)**2)

!      error(1) = real(sdev(i) + error(1)) / 2
!      error(3) = epsilon(error)

!      write(*,'(5g15.3)') apmag(i),area(i),area(i)*skyvar,sdev(i),sigsq*area(i)**2

      ! readns ?????

! For Munipack, we needs counts. Sum in aperture is multiplied
! by phpadu (gain) to get detected counts instead of digitalized
! data.

      apcts(n,i) = real(apmag(i)*phpadu)
      ! in Munipack, the noise of flat-field (and others) is also included:
      apcts_err(n,i) = real(sqrt(error(1) + error(2) + error(3)))
      !      apcts_err(n,i) = sqrt(phpadu*(error(1) + error(2) + error(3) + sdev(i)**2))
!      write(*,*) sqrt(error(1)), sqrt(error(2)),  sqrt(error(3)),stderr(int(xc),int(yc))!sqrt(sdev(i))
!      apcts_err(n,i) = sqrt(apmag(i))

!
! These variables ERRORn are the respective variances (squares of the
! mean errors) for: (1) random noise inside the star aperture, including
! readout noise and the degree of contamination by other stars in the
! neighborhood, as estimated by the scatter in the sky values (this
! standard error increases as the square root of the area of the
! aperture); (2) the Poisson statistics of the observed star brightness;
! (3) the uncertainty of the mean sky brightness (this standard error
! increases directly with the area of the aperture).
!
      magerr(i) = real(min(9.999d0, 1.0857*sqrt(error(1) + error(2) + error(3))/apmag(i)))
      apmag(i) = 25.0 - 2.5*log10(apmag(i)*phpadu)
      if (apmag(i) > 99.999) go to 2210
      go to 2220
2210  continue
      apmag(i) = 99.999
      magerr(i) = 9.999
      apcts(n,i) = -1
      apcts_err(n,i) = -1
2220  continue
      enddo
!
!  NOTICE: a nice example of goto's
!
! Write out the answers.
!
!      if (watch > 0.5) then
      if( verbose ) then
         write (*,"(10X, I5, 2F8.1, F9.3, ' +-', F6.3, 3x, g0.3)") &
              istar, xc, yc, apmag(1), magerr(1), skymod
!         write (*,"(/1X, I5, 14F9.3)") istar, xc, yc, (apmag(i), i=1,naper)
!         write (*,"(4X, F9.3, 2F6.2, F8.3, 11F9.3)") skymod, min(99.99,skysig),&
!              min(999.99, max(-99.99,skyskw)), (magerr(i), i=1,naper)
      endif

      if( plog ) then
         write(*,'(a,2(f0.3,1x),es15.5)') '=APHOT> ',xc,yc,apcts(n,1)
      end if

      xsky(n) = skymod*phpadu
!      xsky_err(n) = sqrt(sigsq*phpadu**2)
      xsky_err(n) = skyerr*phpadu

      if (apmag(1) < 99.0) then
         wt = (2.0/(2.0 - dmag))*(100.0/magerr(1))**2
         maglim = maglim + wt*(apmag(1) - dmag)
         magsq = magsq + wt*(apmag(1) - dmag)**2
         sumwt = sumwt + wt
         nmag = nmag + 1
      endif

3333  continue
   enddo ! n
!
!-----------------------------------------------------------------------
!
! Normal return.
!
! Estimate magnitude limit, close files, and return.
!

deallocate(sky)

!call clfile (3)
!call clfile (2)
if (sumwt <= 0.0) return
maglim = maglim/sumwt
magsq = magsq/sumwt - maglim**2
magsq = sqrt(max(0.0d0, magsq))

if( verbose ) &
     write (*,"('    Estimated magnitude limit (Aperture 1): ', F4.1,' +-', F4.1, ' per star.')") maglim, magsq

if( verbose ) write(*,"(a,i0,a)") " Found ",size(xstar)," star(s)."

!      call stupid (line)
return
!
!-----------------------------------------------------------------------
!
!666 continue
if ( allocated(sky) ) deallocate(sky,dsky)
status = 1

end subroutine daophotsb

end module mdaofotometr
