!
!  FITSIO definitions - directly derived from f77.inc
!
!  Copyright © 2010-8 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 fitsio

  ! version identification

  character(len=*), parameter :: MUNIPACK_VERSION = &
       "Munipack 0.5.10, (C)1997-2018 F. Hroch <hroch@physics.muni.cz>"

  character(len=*), parameter :: FITS_VALUE_CREATOR = "Munipack 0.5.10"
  character(len=*), parameter :: FITS_COM_CREATOR = "http://munipack.physics.muni.cz"

  ! basic constants (fitsio.h)
  integer, parameter :: FLEN_FILENAME = 1025 ! max length of a filename
  integer, parameter :: FLEN_KEYWORD = 72    ! max length of a keyword (include HIERARCH)
  integer, parameter :: FLEN_CARD = 81       ! length of a FITS header card
  integer, parameter :: FLEN_VALUE = 71      ! max length of a keyword value string
  integer, parameter :: FLEN_COMMENT = 73    ! max length of a keyword comment string
  integer, parameter :: FLEN_ERRMSG = 81     ! max length of a FITSIO error message
  integer, parameter :: FLEN_STATUS = 31     ! max length of a FITSIO status text string


  ! Merged from f77.inc (cfitsio distribution)

  ! Codes for FITS extension types
  integer, parameter :: &
       IMAGE_HDU = 0, &
       ASCII_TBL = 1, &
       BINARY_TBL = 2, &
       ANY_HDU = 2

  integer, parameter :: &
       READONLY = 0, &
       READWRITE = 1

  ! Codes for FITS table data types
  integer, parameter :: &
       TBIT        =   1, &
       TBYTE       =  11, &
       TLOGICAL    =  14, &
       TSTRING     =  16, &
       TSHORT      =  21, &
       TINT        =  31, &
       TFLOAT      =  42, &
       TDOUBLE     =  82, &
       TCOMPLEX    =  83, &
       TDBLCOMPLEX = 163

  ! Codes for iterator column types
  integer, parameter :: &
       InputCol       = 0, &
       InputOutputCol = 1, &
       OutputCol      = 2

  ! codes for header record class
  integer, parameter :: &
       TYP_STRUC_KEY = 10, &
       TYP_CMPRS_KEY = 20, &
       TYP_SCAL_KEY  = 30, &
       TYP_NULL_KEY  = 40, &
       TYP_DIM_KEY   = 50, &
       TYP_RANG_KEY  = 60, &
       TYP_UNIT_KEY  = 70, &
       TYP_DISP_KEY  = 80, &
       TYP_HDUID_KEY = 90, &
       TYP_CKSUM_KEY = 100,&
       TYP_WCS_KEY   = 110,&
       TYP_REFSYS_KEY= 120,&
       TYP_COMM_KEY  = 130,&
       TYP_CONT_KEY  = 140,&
       TYP_USER_KEY  = 150


  integer, parameter :: FILE_NOT_OPENED = 104
  integer, parameter :: BAD_HDU_NUM = 301 ! HDU number < 1 or > MAXHDU
  integer, parameter :: KEYWORD_NOT_FOUND = 202
  integer, parameter :: COLUMN_NOT_FOUND = 219
  integer, parameter :: NUMERICAL_OVERFLOW = 412
  integer, parameter :: MULTIPLE_MATCH = 237

  character(len=*), parameter :: FINDEXTNAME = 'FIND'
  character(len=*), parameter :: APEREXTNAME = 'APERPHOT'
  character(len=*), parameter :: GROWEXTNAME = 'GROWPHOT'
  character(len=*), parameter :: GROWCURVEXTNAME = 'GROWCURVE'
  character(len=*), parameter :: GROWFUNCEXTNAME = 'GROWFUNC'
  character(len=*), parameter :: GROWDATEXTNAME = 'GROWDATA'
  character(len=*), parameter :: PSFEXTNAME  = 'PSFPHOT'
  character(len=*), parameter :: PHOTOEXTNAME= 'PHOTOMETRY'
  character(len=*), parameter :: MEXTNAMETS =  'TIMESERIES'
  character(len=*), parameter :: MEXTNAMETSC = 'CATALOGUE'
  character(len=*), parameter :: FHDUNAME =    'PHOTOSYS'
  character(len=*), parameter :: FTHDUNAME =   'FOTRAN'
  character(len=*), parameter :: EXT_STDERR =  'STDERR'
  character(len=*), parameter :: EXT_PHRES =   'PHRES'

  character(len=*), parameter :: BEGIN_ASTROMETRY = &
       '=== Astrometric Solution by Munipack ==='
  character(len=*), parameter :: END_ASTROMETRY = &
       '=== End of Astrometric Solution by Munipack ==='
  character(len=*), parameter :: BEGIN_PHOTOCAL = &
       '=== Photometric Calibration by Munipack ==='
  character(len=*), parameter :: END_PHOTOCAL = &
       '=== End of Photometric Calibration by Munipack ==='

  character(len=*), parameter :: FITS_KEY_NAPER = 'NAPER'
  character(len=*), parameter :: FITS_KEY_APER = 'APER'
  character(len=*), parameter :: FITS_KEY_SAPER = 'SAPER'
  character(len=*), parameter :: FITS_KEY_ANNULUS = 'ANNULUS'
  character(len=*), parameter :: FITS_KEY_FWHM = 'FWHM'
  character(len=*), parameter :: FITS_KEY_HWHM = 'HWHM'
  character(len=*), parameter :: FITS_KEY_RF90 = 'RADFLX90'
  character(len=*), parameter :: FITS_KEY_EXTINK0 = 'EXTIN_K0'
  character(len=*), parameter :: FITS_KEY_EXTINR = 'EXTIN_R'
  character(len=*), parameter :: FITS_KEY_EXTINREF = 'EXTINREF'
  character(len=*), parameter :: FITS_KEY_THRESHOLD = 'THRESH'
  character(len=*), parameter :: FITS_KEY_LOWBAD = 'LOWBAD'
  character(len=*), parameter :: FITS_KEY_HIGHBAD = 'HIGHBAD'
  character(len=*), parameter :: FITS_KEY_RNDLO = 'RNDLO'
  character(len=*), parameter :: FITS_KEY_RNDHI = 'RNDHI'
  character(len=*), parameter :: FITS_KEY_SHRPLO = 'SHRPLO'
  character(len=*), parameter :: FITS_KEY_SHRPHI = 'SHRPHI'
  character(len=*), parameter :: FITS_KEY_PHOTPLAM = 'PHOTPLAM'
  character(len=*), parameter :: FITS_KEY_PHOTZPT = 'PHOTZPT'
  character(len=*), parameter :: FITS_KEY_PHOTFLAM = 'PHOTFLAM'
  character(len=*), parameter :: FITS_KEY_PHOTBW = 'PHOTBW'
  character(len=*), parameter :: FITS_KEY_CTPH = 'CTPH'
  character(len=*), parameter :: FITS_KEY_CTPHERR = 'CTPHERR'
  character(len=*), parameter :: FITS_KEY_CSPACE = 'CSPACE'
  character(len=*), parameter :: FITS_KEY_REFRAME = 'REFRAME'
  character(len=*), parameter :: FITS_KEY_SATURATE = 'SATURATE'
  character(len=*), parameter :: FITS_KEY_GAIN = 'GAIN'
  character(len=*), parameter :: FITS_KEY_READNS = 'READNS'
  character(len=*), parameter :: FITS_KEY_AREA = 'AREA'
  character(len=*), parameter :: FITS_KEY_EXPTIME = 'EXPTIME'
  character(len=*), parameter :: FITS_KEY_PHOTSYS = 'PHOTSYS'
  character(len=*), parameter :: FITS_KEY_FILTER = 'FILTER'
  character(len=*), parameter :: FITS_KEY_FILTREF = 'FILTREF'
  character(len=*), parameter :: FITS_KEY_OBJECT = 'OBJECT'
  character(len=*), parameter :: FITS_KEY_OBSERVER = 'OBSERVER'
  character(len=*), parameter :: FITS_KEY_ORIGIN = 'ORIGIN'
  character(len=*), parameter :: FITS_KEY_AUTHOR = 'AUTHOR'
  character(len=*), parameter :: FITS_KEY_INSTRUME = 'INSTRUME'
  character(len=*), parameter :: FITS_KEY_TELESCOP = 'TELESCOP'
  character(len=*), parameter :: FITS_KEY_BIBREF = 'BIBREF'
  character(len=*), parameter :: FITS_KEY_LONGITUDE = 'LONGITUD'
  character(len=*), parameter :: FITS_KEY_LATITUDE =  'LATITUDE'
  character(len=*), parameter :: FITS_KEY_EPOCH = 'EPOCH'
  character(len=*), parameter :: FITS_KEY_CREATOR = 'CREATOR'
  character(len=*), parameter :: FITS_KEY_ORIGHDU = 'ORIGHDU'
  character(len=*), parameter :: FITS_KEY_BUNIT = 'BUNIT'
  character(len=*), parameter :: FITS_KEY_SKYMAG = 'SKYMAG'
  character(len=*), parameter :: FITS_KEY_SKYMEAN = 'SKYMEAN'
  character(len=*), parameter :: FITS_KEY_SKYSIG = 'SKYSIG'
  character(len=*), parameter :: FITS_KEY_SKYSTD = 'SKYSTD'
  character(len=*), parameter :: FITS_KEY_IMAGETYP = 'IMAGETYP'
  character(len=*), parameter :: FITS_KEY_DATEOBS = 'DATE-OBS'
  character(len=*), parameter :: FITS_KEY_TIME = 'TIME'
  character(len=*), parameter :: FITS_KEY_TEMPERATURE = 'TEMPERAT'
  character(len=*), parameter :: FITS_KEY_AIRMASS = 'AIRMASS'
  character(len=*), parameter :: FITS_KEY_JD = 'JD'
  character(len=*), parameter :: FITS_KEY_HJD = 'HJD'
  character(len=*), parameter :: FITS_KEY_FILENAME = 'FILENAME'
  character(len=*), parameter :: FITS_KEY_PHOTOTYP = 'PHOTOTYP'

  ! definitions of column labels, common
  character(len=*), parameter :: FITS_COL_TIME = 'TIME'
  character(len=*), parameter :: FITS_COL_X = 'X'
  character(len=*), parameter :: FITS_COL_Y = 'Y'
  character(len=*), parameter :: FITS_COL_RA = 'RAJ2000'
  character(len=*), parameter :: FITS_COL_DEC = 'DEJ2000'
  character(len=*), parameter :: FITS_COL_PMRA = 'pmRA'
  character(len=*), parameter :: FITS_COL_PMDEC = 'pmDE'
  character(len=*), parameter :: FITS_COL_SKY = 'SKY'
  character(len=*), parameter :: FITS_COL_SKYERR = 'SKYERR'
  character(len=*), parameter :: FITS_COL_R = 'R'
  character(len=*), parameter :: FITS_COL_GROW = 'GROWCURVE'
  character(len=*), parameter :: FITS_COL_GROWERR = 'GROWCURVEERR'
  character(len=*), parameter :: FITS_COL_RPROF = 'RADIALPROFILE'
  character(len=*), parameter :: FITS_COL_RESGROW = 'RESGROW'
  character(len=*), parameter :: FITS_COL_GROWFLAG = 'GROWFLAG'

  ! definitions of column labels, find
  character(len=*), parameter :: FITS_COL_PEAKRATIO = 'PEAKRATIO'
  character(len=*), parameter :: FITS_COL_SHARP = 'SHARP'
  character(len=*), parameter :: FITS_COL_ROUND = 'ROUND'

  ! definitions of column labels, general photometry
  character(len=*), parameter :: FITS_COL_COUNT =     'COUNT'
  character(len=*), parameter :: FITS_COL_COUNTERR =  'COUNTERR'
  character(len=*), parameter :: FITS_COL_PHOTON =    'PHOTON'
  character(len=*), parameter :: FITS_COL_PHOTONERR = 'PHOTONERR'
  character(len=*), parameter :: FITS_COL_PHOTRATE =    'PHOTRATE'
  character(len=*), parameter :: FITS_COL_PHOTRATEERR = 'PHOTRATEERR'

  ! definitions of column labels, aperture photometry
  character(len=*), parameter :: FITS_COL_APCOUNT =    'APCOUNT'
  character(len=*), parameter :: FITS_COL_APCOUNTERR = 'APCOUNTERR'

  ! definitions of column labels, growth-curve photometry
  character(len=*), parameter :: FITS_COL_GCOUNT =    'GCOUNT'
  character(len=*), parameter :: FITS_COL_GCOUNTERR = 'GCOUNTERR'

  ! definitions of column labels, L-photometry
  character(len=*), parameter :: FITS_COL_LBCOUNT =    'LBCOUNT'
  character(len=*), parameter :: FITS_COL_LBCOUNTERR = 'LBCOUNTERR'

  ! definitions of column labels, PSF photometry
  character(len=*), parameter :: FITS_COL_PSFCOUNT =   'PSFCOUNT'
  character(len=*), parameter :: FITS_COL_PSFCOUNTERR ='PSFCOUNTERR'
  character(len=*), parameter :: FITS_COL_PSFPEAK =    'PSFPEAK'
  character(len=*), parameter :: FITS_COL_PSFPEAKERR = 'PSFPEAKERR'

  ! definitions of column labels, output photometry quantities
  character(len=*), parameter :: FITS_COL_PHOTNU =     'PHOTNU'
  character(len=*), parameter :: FITS_COL_PHOTNUERR =  'PHOTNUERR'
  character(len=*), parameter :: FITS_COL_PHOTLAM =    'PHOTLAM'
  character(len=*), parameter :: FITS_COL_PHOTLAMERR = 'PHOTLAMERR'
  character(len=*), parameter :: FITS_COL_FLUX =       'FLUX'
  character(len=*), parameter :: FITS_COL_FLUXERR =    'FLUXERR'
  character(len=*), parameter :: FITS_COL_FNU =        'FNU'
  character(len=*), parameter :: FITS_COL_FNUERR =     'FNUERR'
  character(len=*), parameter :: FITS_COL_FLAM =       'FLAM'
  character(len=*), parameter :: FITS_COL_FLAMERR=     'FLAMERR'
  character(len=*), parameter :: FITS_COL_MAG =        'MAG'
  character(len=*), parameter :: FITS_COL_MAGERR =     'MAGERR'
  character(len=*), parameter :: FITS_COL_ABMAG =      'ABMAG'
  character(len=*), parameter :: FITS_COL_ABMAGERR =   'ABMAGERR'
  character(len=*), parameter :: FITS_COL_STMAG =      'STMAG'
  character(len=*), parameter :: FITS_COL_STMAGERR =   'STMAGERR'
  character(len=*), parameter :: FITS_COL_RATE =       'RATE'
  character(len=*), parameter :: FITS_COL_RATEERR =    'RATEERR'

  character(len=*), parameter :: FITS_COL_FILTER =     'FILTER'

  character(len=*), parameter :: FITS_COL_LAMEFF =     'LAM_EFF'
  character(len=*), parameter :: FITS_COL_LAMFWHM =    'LAM_FWHM'
  character(len=*), parameter :: FITS_COL_NUEFF =      'NU_EFF'
  character(len=*), parameter :: FITS_COL_NUFWHM =     'NU_FWHM'
  character(len=*), parameter :: FITS_COL_FNUREF =     'FNU_REF'
  character(len=*), parameter :: FITS_COL_FLAMREF =    'FLAM_REF'

!  character(len=*), parameter :: FITS_COL__ERR = '_ERR'


!!$  interface
!!$
!!$     subroutine ftpcle(unit,colnum,frow,felem,nelements,values,status)
!!$       integer, intent(in) :: unit, colnum, frow,felem,nelements
!!$       real, dimension(:), intent(in) :: values
!!$       integer, intent(out) :: status
!!$     end subroutine ftpcle
!!$
!!$  end interface

  interface
     function ftgkcl(buf)
       integer :: ftgkcl
       character(len=*) :: buf
     end function ftgkcl
  end interface

  private :: fremove

contains

    subroutine fitscopy(from,to,status)

    character(len=*), intent(in) :: from,to
    integer, intent(out) :: status
    integer :: blocksize = 0

    status = 0
    call ftopen(15,from,0,blocksize,status)
    call ftinit(16,to,blocksize,status)
    call ftcpfl(15,16,1,1,1,status)
    call ftclos(16,status)
    call ftclos(15,status)
    call ftrprt('STDERR',status)

  end subroutine fitscopy

  subroutine fitsbackup(file,backup,status,rem)

    character(len=*), intent(in) :: file,backup
    integer, intent(out) :: status
    logical, intent(in), optional :: rem
    logical :: rm = .true.

    if( present(rem) ) rm = rem

    ! remove backup when exist
    if( backup /= '' ) then
       call fremove(backup)

       ! copy the file to backup
       call fitscopy(file,backup,status)

    end if

    ! optionally remove the old file
    if( rm ) call fremove(file)

  end subroutine fitsbackup

  subroutine fitsback(file,backup,output,rem,outname,status)

    character(len=*), intent(in) :: file,backup,output
    character(len=*), intent(out) :: outname
    logical, intent(in) :: rem
    integer, intent(inout) :: status

    if( status /= 0 ) return

    if( output /= '' ) then
       if( backup /= '' ) then
          call fitsbackup(output,backup,status,rem)
!  !!! removed when storing to a different directory failed with
!      "failed to create new file (already exists?):"
!       else
!          call fitscopy(file,output,status)
       end if
       outname = output
    else
       if( backup /= '' ) then
          call fitsbackup(file,backup,status,rem)
       end if
       outname = file
    end if

  end subroutine fitsback

  subroutine fremove(file)

    character(len=*), intent(in) :: file
    logical :: ex

    inquire(file=file,exist=ex)
    if( ex ) then
       open(26,file=file)
       close(26,status='DELETE')
    end if

  end subroutine fremove


  ! DESIGN FOR FUTURE:
  ! subroutine fitsio_init(unit,file,newfile,status)
  !  if( newfile /= '' ) then
  !    default = 'fitsio_XXXX.fits'
  !  else
  !     default = newfile
  !   endif
  !   call fremove(default)
  !   call ftinit(unit,default,...,status)
  !
  ! subroutine fitsio_close(unit,backup,status)
  !   if( backup /= '' ) call fitscopy(file,backup)
  !   if( newfile == '' ) call fitscopy(default,file)
  !
  ! subroutine fitsio_ftp2d(unit,obr,status)
  !   n(i) = size(obr,i)
  !   call ftp2de(unit,1,n(1),n(1),n(2),obr,status)


  subroutine fitsio_unlink(file)

    character(len=*), intent(in) :: file
    logical :: ex

    inquire(file=file,exist=ex)
    if( ex ) then
       open(26,file=file)
       close(26,status='DELETE')
    end if

  end subroutine fitsio_unlink


end module fitsio
