!> @file tecplot_writer.f90
!> @brief Dimension-agnostic Tecplot writers. ASCII (ordered POINT zone) and
!!        classic binary (#!TDV112). `data(nvar, npts)` is i-fastest; the first
!!        ndim rows are coordinates. Operates on the assembled rank-0 field.
module tecplot_writer
  use, intrinsic :: iso_fortran_env, only: int32, real32, real64
  use precision, only: wp
  implicit none
  private
  public :: write_tecplot_ascii, write_tecplot_binary

contains

  subroutine write_tecplot_ascii(filename, title, var_names, imax, jmax, data, &
                                 is_ok, message)
    character(len=*), intent(in) :: filename, title
    character(len=*), intent(in) :: var_names(:)
    integer, intent(in) :: imax, jmax
    real(wp), intent(in) :: data(:, :)
    logical, intent(out) :: is_ok
    character(len=*), intent(out) :: message

    integer :: u, ios, k, p, nvar, npts
    character(len=:), allocatable :: varline

    is_ok = .false.; message = ''
    nvar = size(var_names); npts = imax * jmax

    if (imax < 1 .or. jmax < 1 .or. size(data, 1) < nvar .or. size(data, 2) < npts) then
      message = 'tecplot_writer: invalid dims or data shape'
      return
    end if

    open (newunit=u, file=filename, status='replace', action='write', iostat=ios)
    if (ios /= 0) then
      message = 'tecplot_writer: cannot open "'//trim(filename)//'"'; return
    end if

    write (u, '(a)', iostat=ios) 'TITLE = "'//trim(title)//'"'
    if (ios /= 0) then
      message = 'tecplot_writer: ascii write error'; close (u, iostat=ios); return
    end if
    varline = 'VARIABLES ='
    do k = 1, nvar
      varline = varline//' "'//trim(var_names(k))//'"'
    end do
    write (u, '(a)', iostat=ios) varline
    if (ios /= 0) then
      message = 'tecplot_writer: ascii write error'; close (u, iostat=ios); return
    end if
    if (jmax > 1) then
      write (u, '(a,i0,a,i0,a)', iostat=ios) 'ZONE I=', imax, ', J=', jmax, ', DATAPACKING=POINT'
    else
      write (u, '(a,i0,a)', iostat=ios) 'ZONE I=', imax, ', DATAPACKING=POINT'
    end if
    if (ios /= 0) then
      message = 'tecplot_writer: ascii write error'; close (u, iostat=ios); return
    end if

    do p = 1, npts
      write (u, '(*(ES24.12E3))', iostat=ios) (data(k, p), k=1, nvar)
      if (ios /= 0) then
        message = 'tecplot_writer: ascii write error'; close (u, iostat=ios); return
      end if
    end do

    close (u, iostat=ios)
    if (ios /= 0) then
      message = 'tecplot_writer: ascii close failed for "'//trim(filename)//'"'
      return
    end if
    is_ok = .true.
  end subroutine write_tecplot_ascii

  subroutine write_tecplot_binary(filename, title, var_names, imax, jmax, data, &
                                  is_ok, message)
    character(len=*), intent(in) :: filename, title
    character(len=*), intent(in) :: var_names(:)
    integer, intent(in) :: imax, jmax
    real(wp), intent(in) :: data(:, :)
    logical, intent(out) :: is_ok
    character(len=*), intent(out) :: message

    integer :: u, ios, k, nvar, npts
    real(real64) :: vmin, vmax

    is_ok = .false.; message = ''
    nvar = size(var_names); npts = imax * jmax

    if (imax < 1 .or. jmax < 1 .or. size(data, 1) < nvar .or. size(data, 2) < npts) then
      message = 'tecplot_writer: invalid dims or data shape'
      return
    end if

    open (newunit=u, file=filename, status='replace', action='write', &
          form='unformatted', access='stream', iostat=ios)
    if (ios /= 0) then
      message = 'tecplot_writer: cannot open "'//trim(filename)//'"'; return
    end if

    ! ---------- header ----------
    ! Stream-unformatted writes emit raw bytes with no record markers, so a
    ! grouped write is byte-identical to one value per statement (the
    ! binary-header-and-data round-trip test pins the exact layout). Every
    ! write checks iostat and funnels failures to the 900 cleanup label.
    write (u, iostat=ios) '#!TDV112', 1_int32, 0_int32
    if (ios /= 0) goto 900
    call write_tp_string(u, trim(title), ios)
    if (ios /= 0) goto 900
    write (u, iostat=ios) int(nvar, int32)
    if (ios /= 0) goto 900
    do k = 1, nvar
      call write_tp_string(u, trim(var_names(k)), ios)
      if (ios /= 0) goto 900
    end do
    write (u, iostat=ios) 299.0_real32
    if (ios /= 0) goto 900
    call write_tp_string(u, 'ZONE001', ios)
    if (ios /= 0) goto 900
    write (u, iostat=ios) - 1_int32, -1_int32, 0.0_real64, -1_int32, &
      0_int32, 0_int32, 0_int32, 0_int32, &
      int(imax, int32), int(jmax, int32), 1_int32, 0_int32, 357.0_real32
    if (ios /= 0) goto 900

    ! ---------- data section ----------
    write (u, iostat=ios) 299.0_real32
    if (ios /= 0) goto 900
    do k = 1, nvar
      write (u, iostat=ios) 2_int32
      if (ios /= 0) goto 900
    end do
    write (u, iostat=ios) 0_int32, 0_int32, -1_int32
    if (ios /= 0) goto 900
    do k = 1, nvar
      vmin = real(minval(data(k, 1:npts)), real64)
      vmax = real(maxval(data(k, 1:npts)), real64)
      write (u, iostat=ios) vmin, vmax
      if (ios /= 0) goto 900
    end do
    do k = 1, nvar
      write (u, iostat=ios) real(data(k, 1:npts), real64)
      if (ios /= 0) goto 900
    end do

    close (u, iostat=ios)
    if (ios /= 0) then
      message = 'tecplot_writer: binary close error'
      return
    end if
    is_ok = .true.
    return

900 continue
    message = 'tecplot_writer: binary write error'
    close (u, iostat=ios)
  end subroutine write_tecplot_binary

  !> Write a Tecplot binary string: each character as an int32, null-terminated.
  !! Returns `ios /= 0` on the first failing write so callers can abort cleanly.
  subroutine write_tp_string(u, s, ios)
    integer, intent(in) :: u
    character(len=*), intent(in) :: s
    integer, intent(out) :: ios
    integer :: i
    ios = 0
    do i = 1, len(s)
      write (u, iostat=ios) int(iachar(s(i:i)), int32)
      if (ios /= 0) return
    end do
    write (u, iostat=ios) 0_int32
  end subroutine write_tp_string

end module tecplot_writer