!> @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