module cubefitsio_header_write
  use cfitsio_interfaces
  use gfits_types
  use gkernel_interfaces
  use cubefitsio_header
  use cubefitsio_messaging

  public :: fitsio_header_t
  public :: cubefitsio_header_addstr,cubefitsio_header_addcomment
  public :: cubefitsio_header_addi4
  public :: cubefitsio_header_addr4,cubefitsio_header_addr8
  public :: cubefitsio_header_write_card
  private

contains

  subroutine cubefitsio_header_addstr(hfits,key,val,comment,error)
    type(fitsio_header_t), intent(inout) :: hfits
    character(len=*),      intent(in)    :: key
    character(len=*),      intent(in)    :: val
    character(len=*),      intent(in)    :: comment
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: icard
    !
    call gfits_reallocate_dict(hfits%dict,error)
    if (error)  return
    !
    icard = hfits%dict%ncard+1
    hfits%dict%card(icard)%key = key
    hfits%dict%card(icard)%val = ''''//trim(val)//''''
    hfits%dict%card(icard)%comment = comment
    hfits%dict%sort(icard) = icard
    hfits%dict%ncard = icard
  end subroutine cubefitsio_header_addstr

  subroutine cubefitsio_header_addi4(hfits,key,val,comment,error)
    type(fitsio_header_t), intent(inout) :: hfits
    character(len=*),      intent(in)    :: key
    integer(kind=4),       intent(in)    :: val
    character(len=*),      intent(in)    :: comment
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: icard
    !
    call gfits_reallocate_dict(hfits%dict,error)
    if (error)  return
    !
    icard = hfits%dict%ncard+1
    hfits%dict%card(icard)%key = key
    write(hfits%dict%card(icard)%val,'(I20)')  val
    hfits%dict%card(icard)%comment = comment
    hfits%dict%sort(icard) = icard
    hfits%dict%ncard = icard
  end subroutine cubefitsio_header_addi4

  subroutine cubefitsio_header_addr4(hfits,key,val,comment,error)
    type(fitsio_header_t), intent(inout) :: hfits
    character(len=*),      intent(in)    :: key
    real(kind=4),          intent(in)    :: val
    character(len=*),      intent(in)    :: comment
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: icard
    !
    call gfits_reallocate_dict(hfits%dict,error)
    if (error)  return
    !
    icard = hfits%dict%ncard+1
    hfits%dict%card(icard)%key = key
    write(hfits%dict%card(icard)%val,'(E20.8)')  val
    hfits%dict%card(icard)%comment = comment
    hfits%dict%sort(icard) = icard
    hfits%dict%ncard = icard
  end subroutine cubefitsio_header_addr4

  subroutine cubefitsio_header_addr8(hfits,key,val,comment,error)
    type(fitsio_header_t), intent(inout) :: hfits
    character(len=*),      intent(in)    :: key
    real(kind=8),          intent(in)    :: val
    character(len=*),      intent(in)    :: comment
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: icard
    !
    call gfits_reallocate_dict(hfits%dict,error)
    if (error)  return
    !
    icard = hfits%dict%ncard+1
    hfits%dict%card(icard)%key = key
    write(hfits%dict%card(icard)%val,'(E20.13)')  val
    hfits%dict%card(icard)%comment = comment
    hfits%dict%sort(icard) = icard
    hfits%dict%ncard = icard
  end subroutine cubefitsio_header_addr8

  subroutine cubefitsio_header_addcomment(hfits,comment,error)
    type(fitsio_header_t), intent(inout) :: hfits
    character(len=*),      intent(in)    :: comment
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: icard
    !
    call gfits_reallocate_dict(hfits%dict,error)
    if (error)  return
    !
    icard = hfits%dict%ncard+1
    hfits%dict%card(icard)%key = 'COMMENT'
    hfits%dict%card(icard)%val = ''
    hfits%dict%card(icard)%comment = comment
    hfits%dict%sort(icard) = icard
    hfits%dict%ncard = icard
  end subroutine cubefitsio_header_addcomment

  subroutine cubefitsio_header_write_card(unit,card,error)
    integer(kind=4),      intent(in)    :: unit
    type(fits_unkn_0d_t), intent(in)    :: card
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HEADER>UPSERT>CARD'
    integer(kind=4) :: status
    character(len=80) :: str
    !
    status = 0
    !
    if (card%key.eq.'COMMENT') then
      call ftpcom(unit,card%comment,status)
      if (cubefitsio_error(rname,status,error))  return
    else
      write(str,'(A,A,A,T40,A,A)')  &
        card%key(1:8),'= ',trim(card%val),'/ ',card%comment(1:39)
      call ftucrd(unit,card%key,str,status)
      if (cubefitsio_error(rname,status,error))  return
    endif
    !
  end subroutine cubefitsio_header_write_card

end module cubefitsio_header_write
