!
!  Flat     Average of a set of flat-fields.
!  Copyright (C) 1997 - 2017  Filip Hroch, Masaryk University, Brno, 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 aflat

  use LibList
  use robustmean
  use weightedmean
  use robratio
  use robustflat
  use medians
  use fitsio
  use xfitsio
  use iso_fortran_env

  implicit none

  ! debuging
  logical, parameter :: debug = .false.

  logical :: verbose = .false.

  integer, parameter :: dbl = selected_real_kind(15)

  character(len=*), parameter :: afid = 'FLAT'

  ! Default Output image name:
  character(len=FLEN_FILENAME) :: nameflat='flat.fits', backup

  ! No. of image dimensions
  integer, parameter :: DIM = 2

  ! lower and upper limits
  real :: saturate_set =  -1
  real :: threshold_set = 0

  integer :: i,j,eq,nobs, istat, naxis,n,l, iter
  integer, dimension(DIM) :: naxes
  integer :: bitpix = -32
  integer :: maxiter = 7
  character(len=8) :: approximation = 'STANDARD'

  real :: avg, sig, t, savg, dt, g, d, egain, sgain, fmean, time, saturate, &
       eflat, waterline, thresh
  real :: darketime = -1
  real :: etime = -1
  real :: xdark = -1.0
  real :: gain = 1
  logical :: gain_set = .false.
  logical :: gain_estimate = .false.
  real, allocatable, dimension(:,:) :: flat,dflat,res,des,bias,dark,ebias,edark
  real, allocatable, dimension(:) :: fbuf, dbuf, abuf, sbuf, egains
  real, dimension(:,:), pointer :: ccd, err
  logical, allocatable, dimension(:,:) :: mask, bitmask
  character(len=FLEN_FILENAME) :: sb,record,buf,key,val, &
       biasname='', darkname='', maskname=''
  character(len=FLEN_VALUE) :: dateobs,dateobs1,filter,filter1, &
       imagetyp1, imagetyp
  character(len=FLEN_KEYWORD) :: KEY_FILTER=FITS_KEY_FILTER, &
       DATE_OBS=FITS_KEY_DATEOBS, KEY_EXPTIME=FITS_KEY_EXPTIME, &
       KEY_IMAGETYP=FITS_KEY_IMAGETYP, KEY_GAIN=FITS_KEY_GAIN,&
       KEY_SATURATE=FITS_KEY_SATURATE
  type(Imagetype), pointer :: list,curr
  type(xFITS) :: fits, biasfits, darkfits, maskfits
  logical :: reliable, terminate

  buf = ''
  filter1 = ''
  imagetyp1 = ''

  call xfits_init(biasfits)
  call xfits_init(darkfits)
  call xfits_init(maskfits)

  call InitList(list)
  curr => list

  do
     read(*,'(a)',end=20) record

     eq = index(record,'=')
     if( eq == 0 ) stop 'Improper input.'
     key = record(:eq-1)
     val = record(eq+1:)

     if( key == 'OUTPUT' ) then
        read(val,*) nameflat, backup
     endif

     if( key == 'BITPIX' ) then
        read(val,*) bitpix
     endif

     if( key == 'SATURATE' ) then
        read(val,*) saturate_set
        if( saturate_set <= 0 ) stop 'Only positive saturations are allowed.'
     endif

     if( key == 'THRESHOLD' ) then
        read(val,*) threshold_set
        if( threshold_set <= 0 ) stop 'Only positive thresholds are allowed.'
     endif

     if( key == 'GAIN' ) then
        read(val,*) gain
        gain_set = .true.
     endif

     if( key == 'VERBOSE' ) then
        read(val,*) verbose
     endif

     if( key == 'APPROXIMATION' ) then
        read(val,*) approximation
        if( approximation == 'BASIC' ) then
           maxiter = 0
        else !if( approximation == 'STANDARD' ) then
           maxiter = 3
        end if
     endif

     if( key == 'GAIN_ESTIMATE' ) then
        read(val,*) gain_estimate
     endif

     if( key == 'FITS_KEY_FILTER' ) then
        read(val,*) KEY_FILTER
     endif

     if( key == 'FITS_KEY_DATEOBS' ) then
        read(val,*) DATE_OBS
     endif

     if( key == 'FITS_KEY_EXPTIME' ) then
        read(val,*) KEY_EXPTIME
     endif

     if( key == 'FITS_KEY_IMAGETYP' ) then
        read(val,*) KEY_IMAGETYP
     endif

     if( key == 'FITS_KEY_GAIN' ) then
        read(val,*) KEY_GAIN
     endif

     if( key == 'FITS_KEY_SATURATE' ) then
        read(val,*) KEY_SATURATE
     endif

     if( key == 'BIAS' ) then

        read(val,*) biasname
        if( verbose ) write(error_unit,*) "BIAS=",trim(biasname)
        call xfits_read(biasname,biasfits)
        if( .not. biasfits%status ) stop 'Failed to load the bias frame.'

     end if

     if( key == 'XDARK' ) then
        read(val,*) xdark
     end if

     if( key == 'DARK' ) then

        read(val,*) darkname
        if( verbose ) write(error_unit,*) "DARK=",trim(darkname)
        call xfits_read(darkname,darkfits)
        if( .not. darkfits%status ) stop 'Failed to load the dark frame.'

        istat = 0
        call xfits_kye(darkfits,KEY_EXPTIME,darketime,istat)
        if( istat /= 0 ) then
           istat = 0
           darketime = -1
           if( verbose ) &
                write(error_unit,*) "An exposure time for dark frame unknown."
        end if

     end if

     if( key == 'MASK' ) then

        read(val,*) maskname
        if( verbose ) write(error_unit,*) "MASK=",trim(maskname)
        call xfits_read(maskname,maskfits)
        if( .not. maskfits%status ) stop 'Failed to load the mask frame.'

     end if

     if( key == 'FILE' ) then

        if( verbose .and. getno(curr) == 0 ) &
             write(error_unit,*) &
             "Filename, exptime[s], gain[ct/adu], saturation[ct], threshold[ct], mean[ct], std.err., reliable:"

        read(val,*) sb
        if( verbose ) write(error_unit,'(a)',advance="no") trim(sb)//":"

        call xfits_init(fits)
        call xfits_read(sb,fits)
        if( .not. fits%status ) then
           call xfits_deallocate(fits)
           write(error_unit,*) "Filed to read `",trim(sb),"'. Skipping."
           goto 665
        end if

        istat = 0
        call xfits_kys(fits,DATE_OBS,dateobs,istat)
        if( istat /= 0 ) then
           istat = 0
           dateobs = ''
        end if

        call xfits_kys(fits,KEY_FILTER,filter,istat)
        if( istat /= 0 ) then
           istat = 0
           filter = ''
        end if
        if( filter == '' .and. verbose ) &
             write(error_unit,'(a)',advance="no") "Warning: empty filter .. "

        call xfits_kys(fits,KEY_IMAGETYP,imagetyp,istat)
        if( istat /= 0 ) then
           istat = 0
           imagetyp = ''
        end if

        call xfits_kye(fits,KEY_EXPTIME,etime,istat)
        if( istat /= 0 ) then
           istat = 0
           etime = -1
        end if

        if( .not. gain_set ) then
           call xfits_kye(fits,KEY_GAIN,gain,istat)
           if( istat /= 0 ) then
              write(error_unit,*) &
                   "Warning: Gain keyword not found in FITS header of `", &
                   trim(sb),"' (default is 1)."
              istat = 0
              gain = 1
           end if
        end if

        ! first image => initialisation
        if( getno(curr) == 0 )then

           naxis = fits%naxis
           naxes = fits%naxes

           dateobs1 = dateobs
           filter1 = filter
           imagetyp1 = imagetyp

           if( biasfits%status ) then
              if( .not. all(biasfits%naxes == naxes) ) then
                 write(error_unit,*) 'bias:',biasfits%naxes(1),&
                      'x',biasfits%naxes(2), &
                      '     current frame:',naxes(1),'x',naxes(2)
                 stop "Bias has incompatible dimensions."
              end if
           end if

           if( darkfits%status ) then
              if( .not. all(darkfits%naxes == naxes) ) then
                 write(error_unit,*) 'dark:',darkfits%naxes(1), &
                      'x',darkfits%naxes(2), &
                      '     current frame:',naxes(1),'x',naxes(2)
                 stop "Dark has incompatible dimensions."
              end if
           end if

           if( maskfits%status ) then
              if( .not. all(maskfits%naxes == naxes) )then
                 write(error_unit,*) 'bitmask:',maskfits%naxes(1), &
                      'x',maskfits%naxes(2), &
                      '     current frame:',naxes(1),'x',naxes(2)
                 stop "Mask has incompatible dimensions."
              end if
           endif

        else

           if( .not. all(naxes == fits%naxes) ) then
              write(error_unit,*) &
                   "Dimensions of images are mutually incompatible. Skipping."
              goto 665
           endif

           if( imagetyp1 /= imagetyp ) &
              write(error_unit,'(a)',advance="no") &
                   "Warning: Image-types does not corresponds. .. current `",&
                   trim(imagetyp),"'(?)"

           if( filter /= filter1 ) write(error_unit,'(a)',advance="no") &
                "Warning: incompatible filters .. current `",trim(filter),"'(?)"

        endif

        ! dark frame multiplicator
        if( xdark > 0 )then
           time = xdark
        else if( etime > 0 .and. darketime > 0 )then
           time = etime / darketime
        else
           time = 1
        end if

        ! saturation
        if( saturate_set > 0 ) then
           saturate = saturate_set
        else
           call xfits_kye(fits,KEY_SATURATE,saturate,istat)
           if( istat /= 0 ) then
              istat = 0
              if( fits%bitpix > 0 ) then
                 saturate = 2.0**fits%bitpix - 1
              else
                 saturate = maxval(fits%image)*(1 + epsilon(saturate))
              end if
           end if
        end if

        ! threshold
        if( threshold_set > 0 ) then
           thresh = threshold_set
        else
           thresh = 0
        end if

        allocate(ccd(naxes(1),naxes(2)),err(naxes(1),naxes(2)), &
             mask(naxes(1),naxes(2)),bias(naxes(1),naxes(2)), &
             dark(naxes(1),naxes(2)),ebias(naxes(1),naxes(2)), &
             edark(naxes(1),naxes(2)),bitmask(naxes(1),naxes(2)))

        if( biasfits%status ) then
           bias = biasfits%image
           ebias = biasfits%stderr
        else
           bias = 0
           ebias = 0
        end if
        if( darkfits%status ) then
           dark = darkfits%image
           edark = darkfits%stderr
        else
           dark = 0
           edark = 0
        end if
        if( maskfits%status ) then
           bitmask = maskfits%image > 0.5
        else
           bitmask = .true.
        end if

        ! Preparatory correct the input flat.
        ! Standard deviation is set with assumption of Poisson distribution
        ! of data. It requires large light fluxes, around half of a full range.
        mask =  thresh < fits%image .and. fits%image < saturate .and. bitmask
        where( mask )
           ccd = gain*(fits%image - (bias + time*dark))
        elsewhere
           ccd = -1
        end where
        saturate = gain * saturate
        thresh = gain * thresh
        mask =  thresh < ccd .and. ccd < saturate .and. mask
        where( mask )
           err = sqrt(ccd + gain**2*(ebias**2 + time**2*edark**2))
        elsewhere
           err = -1
        end where
        ! Important. Pixels out of the mask has negative values.

        ! the average is computed by one million elements or less
        n = (naxes(1)*naxes(2)) / 1000000
        if( n > 0 ) then
           l = 0
           do i = 1,naxes(1)
              do j = 1,naxes(2)
                 l = l + 1
                 if( mod(l,n) /= 0 ) mask(i,j) = .false.
              end do
           end do
        end if

        ! determine mean level of current frame
        call rwmean(pack(ccd,mask),pack(err,mask),avg,savg,sig, &
             reliable=reliable)

        if( verbose ) &
             write(error_unit, &
             '(2x,1pg0.3,2x,0pf0.2,2x,1p,2(g0.2,1x),2x,1pg0.5,3x,1pg0.3,l2)') &
             etime,gain,saturate,thresh,avg,sig,reliable

        if( .not. (avg > 0) ) then
           write(error_unit,*) &
                'This frame has zero or negative mean level. Skipping.'
           deallocate(ccd,err)
        else
           ! add image to the list
           Call AddItem (curr,image=ccd,noise=err,filename=sb,mean=avg, &
                stderr=savg,stdsig=sig,dateobs=dateobs,filter=filter, &
                satur=saturate)
        end if

        deallocate(mask,bias,dark,ebias,edark,bitmask)
665     continue
        call xfits_deallocate(fits)

     end if

  enddo

20 continue
  nobs = getno(curr)

  if( nobs == 0 ) stop 'No input image(s).'

  if( verbose ) then
     write(error_unit,*)
     write(error_unit,*) 'Number of input images:',nobs
     write(error_unit,*) 'Dimensions:',naxes(1),'x',naxes(2)
     write(error_unit,*) 'Filter: ',trim(filter1)
     write(error_unit,*) 'Precision of appoximation: ',trim(approximation)
  end if

  ! Section: flat-field computation by flux calibration
  allocate(flat(naxes(1),naxes(2)),dflat(naxes(1),naxes(2)),&
       res(naxes(1),naxes(2)),des(naxes(1),naxes(2)),mask(naxes(1),naxes(2)), &
       fbuf(nobs),dbuf(nobs),abuf(nobs),sbuf(nobs),bitmask(naxes(1),naxes(2)),&
       egains(nobs))

  if( maskfits%status ) then
     bitmask = maskfits%image > 0.5
  else
     bitmask = .true.
  end if

  ! Initial mean flat
  if( verbose ) write(error_unit,'(a)') &
       'Calculating the initial flat-field frame (iter. #0) ...'
  do j = 1,naxes(2)
     do i = 1,naxes(1)

        ! this is initial estimate only
        ! lighter frames has smaller influence due Poisson statistics
        curr => list
        n = 0
        do
           curr => GetNext(curr)
           if( .not. associated(curr) ) exit
           call GetItem(curr,image=ccd,noise=err,mean=avg,stdsig=sig, &
                satur=saturate)
           if( thresh < ccd(i,j) .and. ccd(i,j) < saturate .and. &
                err(i,j) > 0 .and. bitmask(i,j) .and. avg > 0 ) then
              n = n + 1
              fbuf(n) = ccd(i,j) / avg
              dbuf(n) = sqrt(err(i,j)**2 / avg**2 + sig**2)
           end if
        enddo
        if( n > 0 ) then
           call rwmean(fbuf(1:n),dbuf(1:n),flat(i,j),dflat(i,j), &
                reliable=reliable)
           if( .not. reliable ) &
                call rmean(fbuf(1:n),flat(i,j),dflat(i,j))
        else
           flat(i,j) = 1
           dflat(i,j) = 0
        end if

     enddo
  enddo

  if( debug ) then
     ! write out the first estimate

     mask = bitmask
     where( mask )
        des = sqrt(err**2 + dflat**2)
        res = (flat - 1) / des
     end where

     open(1,file='/tmp/flatdebug_zero.dat')
     do i = 1,size(flat,1),2
        do j = 1,size(flat,2),2
           if( mask(i,j) .and. abs(res(i,j)) < 5 ) then
              write(1,*) flat(i,j)-1,res(i,j), flat(i,j)
           end if
        end do
     end do
     close(1)

  end if

  terminate = .false.
  do iter = 1, maxiter

     ! Now, we're Improving precision of approximation. The number of
     ! iterations is controled by `terminate' variable which tests
     ! convergence of subsequent estimates of the created flat.

     if( terminate ) exit

     if( verbose ) then
        write(error_unit,'(a)') 'Scaling individual frames by the flat ...'
        write(error_unit,'(a)',advance="no") &
             "Filename,      mean level[ct],  std.err., reliable"
        if( gain_estimate ) then
           write(error_unit,'(a)') ",  std.dev.,  gain:"
        else
           write(error_unit,'(a)') ":"
        end if
     end if

     ! Update means for individual frames
     curr => list
     do ! over frames
        curr => GetNext(curr)
        if( .not. associated(curr) ) exit
        call GetItem(curr,filename=sb,image=ccd,noise=err,mean=avg, &
             satur=saturate)

        mask = thresh < ccd .and. ccd < saturate .and. err > 0 &
             .and. flat > 0 .and. dflat > 0 .and. bitmask
        call rcal(pack(ccd,mask),pack(err,mask),pack(flat,mask), &
             pack(dflat,mask),t,dt,xreliable=reliable,xverb=.false.)
        ! We assumes Poisson distribution of flat pixels, their dispersion
        ! is bound to the mean value. Data with strong fluence of
        ! non-Poisson noise component should be avoided already.

        if( verbose ) then

           write(error_unit, &
                '(a,2x,1pg0.5,2x,1pg0.3,2x,l1)',advance="no") &
                trim(sb)//": ",t,dt,reliable

           ! gain estimate
           if( gain_estimate ) then
              call rmean(pack(ccd/flat, mask),fmean,savg,sig)
              g = fmean / sig**2
              write(error_unit,'(1x,1pg0.5,2x,0pf0.3)') sig,g
              egains(curr%i) = g

              ! The value of fmean is principally identical to t by rcal.
              ! The rmean is convenience way how to determine variance
              ! (rcal uses regularisation which gives var ~ 1 in any case).
           else
              write(error_unit,*)
           end if

        end if

        ! update only when our estimate is realiable
        if( reliable ) &
           call SetItem(curr,mean=t)

     enddo ! over all frames

     ! update flat
     if( verbose ) write(error_unit,'(a,i0,a)') &
          'Calculating a flat-field frame (iter. #',iter,') ...'
     res = -1
     do j = 1,naxes(2)
        do i = 1,naxes(1)

           curr => list
           n = 0
           do
              curr => GetNext(curr)
              if( .not. associated(curr) ) exit
              call GetItem(curr,image=ccd,noise=err,mean=avg,stdsig=sig,&
                   satur=saturate)
              if( thresh < ccd(i,j) .and. ccd(i,j) < saturate .and. &
                   err(i,j) > 0 .and. bitmask(i,j) .and. &
                   avg > 0 .and. sig > 0 ) then
                 n = n + 1
                 fbuf(n) = ccd(i,j)
                 dbuf(n) = err(i,j)
                 abuf(n) = avg
                 sbuf(n) = sig
              end if
           enddo
           if( n > 0 ) then

              avg = flat(i,j)

              if( debug .and. i == naxes(1)/2 .and. j == naxes(2)/2 ) &
                   call rflat(fbuf(1:n),dbuf(1:n),abuf(1:n),sbuf(1:n), &
                   flat(i,j),dflat(i,j),reliable,verbose=.true.)

              call rflat(fbuf(1:n),dbuf(1:n),abuf(1:n),sbuf(1:n), &
                   flat(i,j),dflat(i,j),reliable,verbose=.false.)

              ! Non reliable pixels are silently ignored. The data
              ! has strongly non-gaussian distribution: the case of
              ! bad columns and pixels, an overscan data and etc.
              ! if( .not. reliable .and. verbose ) write(*,*) i,j

              ! the absolute difference between the result of previous
              ! computation and the current one controls termination
              if( reliable ) res(i,j) = abs(avg - flat(i,j))

           else
              flat(i,j) = 1
              dflat(i,j) = 0
           end if

        enddo
     enddo

     ! terminate condition: the mean difference between two latest
     ! subsequent iterations is under the mean std.err. limit
     d = median(pack(res,res>0))
     eflat = median(pack(dflat,dflat>0))
     terminate = d < eflat
     if( verbose ) &
          write(error_unit,'(a,3x,1p,2(g0.1,2x),l1)') &
          'Mean residual and std.dev., terminate:',d,eflat,terminate

  end do ! iter

  if( debug ) then
     ! (**)
     ! Diagnostics. The second column of the files
     ! are residuals intended for Normality testing.
     !
     ! https://stackoverflow.com/questions/2471884/
     ! or:
     ! gnuplot> binwidth=0.05
     ! gnuplot> bin(x,width)=width*floor(x/width)
     ! gnuplot> plot '/tmp/flatdebug_666.fits.dat' \
     !          using (bin($2,binwidth)):(1.0) smooth freq with boxes

     curr => list
     do ! over frames
        curr => GetNext(curr)
        if( .not. associated(curr) ) exit
        call GetItem(curr,filename=sb,image=ccd,noise=err,mean=avg, &
             satur=saturate)

        mask = thresh < ccd .and. ccd < saturate .and. &
             flat > 0 .and. dflat > 0 .and. bitmask
        where( mask )
           des = sqrt(err**2 + avg**2*dflat**2)
           res = (ccd - avg*flat) / des
        end where

        write(buf,'(a,i0,a)') '/tmp/flatdebug_',GetNo(curr),'.dat'
        open(1,file=buf)
        write(1,'(2a)') '# ',trim(sb)
        do i = 1,size(ccd,1),2
           do j = 1,size(ccd,2),2
              if( mask(i,j) .and. abs(res(i,j)) < 5 ) then
                 write(1,*) ccd(i,j)-avg,res(i,j), flat(i,j)
              end if
           end do
        end do
        close(1)
     end do

  end if ! debug

  ! final mean over the whole area
  call rmean(pack(flat,bitmask),avg,savg,sig)

  if( gain_estimate ) then
     call rmean(egains,egain,sgain,t)
  end if

  ! integer representation of flat is not recommended in any case,
  ! but it can be useful for a compatibility
  if( bitpix > 0 ) then
     waterline = nint(10.0**(int(log10(2.0**(bitpix-1)))))
     ! waterline updates mean levels on 1e2,1e4 and 1e9
     avg = waterline * avg
     flat = waterline * flat
     dflat = waterline * dflat
     if( verbose ) write(error_unit,*) &
          'Warning: Numerical precision degraded by conversion to integers.'
  end if

  if( verbose ) then
     eflat = median(pack(dflat,dflat>0))
     write(error_unit,'(2a)') ' Output image: ',trim(nameflat)
     write(error_unit,'(a,3x,1pg0.7)') ' Final mean:',avg
     write(error_unit,'(a,3x,1pg0.1)') &
          ' Expected photometry standard error per pixel:',eflat
     if( gain_estimate ) then
        write(error_unit,'(a,2(2x,f0.3),a,f0.3,a)') &
             ' Estimated relative gain, std.err:',egain,sgain, &
             ' (original gain was ',gain,').'
     end if
  end if

  ! Output image
  istat = 0
  call fitsbackup(nameflat,backup,istat)
  call ftinit(26,nameflat,1,istat)
  call ftphps(26,bitpix,naxis,naxes,istat)
  if( gain_estimate ) then
     call ftpkye(26,'GAIN_AVG',egain,6,'[ct/ADU] estimated gain',istat)
     call ftpkye(26,'GAIN_STD',sgain,2,'[ct/ADU] std.dev of estimated gain',&
          istat)
  end if
  if( filter1 /= '' ) &
       call ftpkys(26,KEY_FILTER,filter1,'filter',istat)
  if( imagetyp1 /= '' ) &
     call ftpkys(26,KEY_IMAGETYP,imagetyp,'image type',istat)
  call ftpkys(26,DATE_OBS,dateobs1,'UTC of the first on input',istat)
  if( bitpix > 0 ) then
     call ftpkye(26,'BSCALE',1.0,10,'',istat)
     call ftpkye(26,'BZERO',2.0**(bitpix-1),10,'',istat)
  endif

  if( nobs > 0 ) then
     write(buf,'(a,i0,a)') 'Result of robust flat-fielding of ',nobs,&
          ' exposure(s).'
     call ftpcom(26,buf,istat)
     call ftpcom(26,&
          'Filename, time of start, mean level[ct] for each image used:',&
          istat)
     curr => list
     do
        curr => GetNext(curr)
        if( .not. associated(curr) ) exit
        call GetItem(curr,filename=sb,dateobs=dateobs,mean=t)
        write(buf,'(1pg0.5)') t
        call ftpcom(26,"'"//trim(sb)//"' '"//trim(dateobs)//"' "//trim(buf), &
             istat)
     enddo
  endif

  write(buf,'(f0.3)') gain
  call ftphis(26,afid//" gain: "//trim(buf),istat)

  if( darkname /= '' ) then
     write(buf,'(f0.5)') time
     call ftphis(26,afid//" dark: '"//trim(darkname)//"' *"//trim(buf),istat)
  end if

  if( biasname /= '' ) &
     call ftphis(26,afid//" bias: '"//trim(biasname)//"'",istat)

  if( maskname /= '' ) &
     call ftphis(26,afid//" bitmask: '"//trim(maskname)//"'",istat)

  write(buf,*) thresh
  call ftphis(26,afid//" threshold: "//trim(buf)//" [ct] (gain applied)",istat)

  write(buf,*) saturate
  call ftphis(26,afid//" saturation: "//trim(buf)//" [ct] (gain applied)",istat)

  write(buf,*) avg
  call ftphis(26,afid//" mean level: "//trim(buf)//" [ct]",istat)

  call ftukys(26,FITS_KEY_CREATOR,FITS_VALUE_CREATOR,FITS_COM_CREATOR,istat)
  call ftpcom(26,MUNIPACK_VERSION,istat)

  ! flat-field generated
  call ftp2de(26,1,naxes(1),naxes(1),naxes(2),flat,istat)

  ! standard error of mean
  call ftiimg(26,bitpix,naxis,naxes,istat)
  call ftukys(26,'EXTNAME',EXT_STDERR,'',istat)
  call ftpcom(26,&
       'The estimation of standard error of mean of pixels of flat-field.',&
       istat)
  call ftp2de(26,1,naxes(1),naxes(1),naxes(2),dflat,istat)

  call ftclos(26,istat)
  call ftrprt('STDERR',istat)

  if( allocated(flat) ) &
       deallocate(flat,dflat,res,des,mask,fbuf,dbuf,abuf,sbuf,egains,bitmask)
  call DestroyList(list)
  call xfits_deallocate(maskfits)
  call xfits_deallocate(biasfits)
  call xfits_deallocate(darkfits)

  if( istat == 0 ) then
     stop 0
  else
     stop 'Failed on FITS I/O error.'
  end if

end program aflat
