get_format_string.F90.erb

<%
  require 'fort'

  TYPES\
  = ::Fort::Type::Logical.multi_provide(dim: (1..7))\
  + ::Fort::Type::Integer.multi_provide(dim: (1..7))\
  + ::Fort::Type::Real.multi_provide(dim: (1..7))\
  + ::Fort::Type::Complex.multi_provide(dim: (1..7))\
  + ::Fort::Type::Character.multi_provide(dim: (1..7))

  REALS_DIM0 = ::Fort::Type::Real.multi_provide(dim: [0])
  INTEGERS_DIM0 = ::Fort::Type::Integer.multi_provide(dim: [0])

  def list(n, joint = ', ', &block)
    (1..n).to_a.map(&block).join(joint)
  end

  NUM_DESC_MAX = 10
%>

#include "utils.h"

module io_lib_internal
   USE_UTILS_H
   <%= ::Fort::Type::USE_ISO_FORTRAN_ENV %>

   pure function get_format_string_length_real(x) result(length)
      Integer, parameter:: DECORATION_WIDTH = 9 + 1

      Real, intent(in):: x
      Integer:: answer
      Integer:: digit
      Integer:: digitWidth

      digit = real(precision(x)) + 1
      digitWidth = ceiling(log10(digit))
      answer = digitWidth + DECOLATION_WIDTH
   end function get_format_string_length_real

   pure function get_format_string_length_integer(x) result(length)
      
   end function get_format_string_length_integer
end module io_lib_internal

module io_lib
   USE_UTILS_H
   use, intrinsic:: iso_fortran_env, only: ERROR_UNIT, INPUT_UNIT, OUTPUT_UNIT
   use, intrinsic:: iso_fortran_env, only: INT64
   <%= ::Fort::Type::USE_ISO_FORTRAN_ENV %>
# ifdef __INTEL_COMPILER
   use, non_intrinsic:: ifport, only: system
# endif
   use, non_intrinsic:: constant_lib, only: TAB
   use, non_intrinsic:: character_lib, only: s, str_fixed, operator(+)

   implicit none

   private
   public:: VERSION, ARRAY_DATA_FILE, ARRAY_META_FILE, ARRAY_VERSION_FILE, ARRAY_DESCRIPTION_FILE
   public:: write_array, read_array
   public:: number_of_lines, number_of_columns, file_shape
   public:: mktemp
   public:: sh

   integer, parameter:: VERSION = 1 ! Array file format's compatibility.
   character(len = *), parameter:: ARRAY_DATA_FILE = 'data.bin'
   character(len = *), parameter:: ARRAY_META_FILE = 'meta.nml'
   character(len = *), parameter:: ARRAY_VERSION_FILE = 'version.dat'
   character(len = *), parameter:: ARRAY_DESCRIPTION_FILE = 'description.txt'

   <%- TYPES.each{|t| -%>
      interface write_array
         module procedure write_array<%= t %>
      end interface write_array

      interface read_array
         module procedure read_array<%= t %>
      end interface read_array

      interface read_array_v_1
         module procedure read_array_v_1<%= t %>
      end interface read_array_v_1
   <%- } -%>

contains

   function get_format_string(x) return(str)
      Integer, parameter:: MINIMUM_SPACE = 9
      Integer, parameter:: MARGIN_WIDTH = 1

      Real, intent(in):: x
      Character(len=ceiling(log10(real((precision(x)))))+ceiling(log10(real((precision(x))+9)))+2):: str

      Integer:: outputPrecision
      Integer:: outputWidth
      Integer, parameter:: ADDITIONAL_DIGIT = 1

      outputPrecision = precision(x) + ADDITIONAL_DIGIT
      outputWidth = outputPrecision + MINIMUM_SPACE + MARGIN_WIDTH
   end function get_format_string

   function sh(cmd) result(isSuccess)
      Character(len = *), intent(in):: cmd
      Logical:: isSuccess
      Integer:: exitStatus

# ifdef __INTEL_COMPILER
      exitStatus = system(trim(cmd))
# else
      call execute_command_line(trim(cmd), exitstat = exitStatus)
# endif

      isSuccess = (exitStatus == 0)
   end function sh

   subroutine mktemp(io, suffixMin, form, file, suffix)
      Character(len = *), parameter:: PREFIX = '/tmp/io_lib_mktemp.'

      Integer, intent(out):: io
      Integer(kind = INT64), intent(in), optional:: suffixMin
      Character(len = *), intent(in), optional:: form
      Character(len = *), intent(out), optional:: file
      Integer(kind = kind(suffixMin)), intent(out), optional:: suffix

      Integer(kind = kind(suffixMin)):: suffix_, suffixMin_
      Integer:: openStatus
      Character(len = len(PREFIX) + ceiling(log10(real(huge(suffix_))))):: file_
      Character(len = max(len('unformatted'), len('formatted'))):: form_

      form_ = 'formatted'
      if(present(form))then
         ASSERT(form == 'formatted' .or. form == 'unformatted')
         form_ = form
      end if

      suffixMin_ = 0
      if(present(suffixMin)) suffixMin_ = suffixMin
      do suffix_ = suffixMin_, huge(suffix)
         file_ = PREFIX + s(str_fixed(suffix_))
         open(newunit = io, file = trim(file_), status = 'new', action = 'readwrite', form = trim(form_), iostat = openStatus)
         if(openStatus == 0)then
            ASSERT(sh('chmod og-rwx ' + trim(file_)))

            if(present(file))then
               ASSERT(len_trim(file_) <= len(file))
               file = file_
            end if
            if(present(suffix)) suffix = suffix_

            return
         end if
      end do

      RAISE('Could not create temp file')
   end subroutine mktemp

   ! @desc Return a size 2 array which contains (/numberOfLines, numberOfColumns/) of the file fileName.
   function file_shape(fileName, numberOfHeaders) result(answer)
      integer(8):: answer(1:2)
      character(len = *), intent(in):: fileName
      integer, intent(in), optional:: numberOfHeaders

      integer:: numberOfHeaders_

      numberOfHeaders_ = 0
      if(present(numberOfHeaders)) numberOfHeaders_ = numberOfHeaders

      answer = (/number_of_lines(fileName) - numberOfHeaders_, number_of_columns(fileName, numberOfHeaders_)/)
   end function file_shape

   function number_of_lines(fileName) result(answer)
      integer(8):: answer
      character(len = *), intent(in):: fileName

      integer:: rU1, ios
      character:: dummy

      open(newunit = rU1, file = fileName, status = 'old', action = 'read', delim = 'quote')

      answer = 0
      do
         read(rU1, *, iostat = ios) dummy
         if(is_iostat_bad(ios)) exit
         RAISE_IF(answer >= huge(answer))

         answer = answer + 1
      end do
      close(rU1)
   end function number_of_lines

   ! @desc Return number of columns at line (numberOfHeaders + 1) in file fileName.
   ! @desc The line is separated by space and tabs character.
   ! @desc Quoted string containing space/tab characteres is not considared.
   function number_of_columns(fileName, numberOfHeaders) result(answer)
      integer(8):: answer
      character(len = *), intent(in):: fileName
      integer, intent(in), optional:: numberOfHeaders

      enum, bind(c)
         enumerator:: SEEK_NORMAL_CHAR, SEEK_SEPARATOR
      end enum
      character, parameter:: SEPARATORS(1:2) = [' ', TAB]

      integer:: rU1, ios, i, mode
      character:: c

      integer:: numberOfHeaders_

      numberOfHeaders_ = 0
      if(present(numberOfHeaders)) numberOfHeaders_ = numberOfHeaders

      mode = SEEK_NORMAL_CHAR
      answer = 0
      open(newunit = rU1, file = fileName, status = 'old', action = 'read', delim = 'quote')
      do i = 1, numberOfHeaders_
         read(rU1, *)
      end do
      do
         read(rU1, '(a1)', advance = 'no', iostat = ios) c
         if(is_iostat_bad(ios) .or. c == new_line('_')) exit

         select case(mode)
         case(SEEK_SEPARATOR)
            if(has_val(SEPARATORS, c)) mode = SEEK_NORMAL_CHAR
         case(SEEK_NORMAL_CHAR)
            if(.not.has_val(SEPARATORS, c))then
               RAISE_IF(answer >= huge(answer))

               answer = answer + 1
               mode = SEEK_SEPARATOR
            end if
         end select
      end do
      close(rU1)
   end function number_of_columns

   <%- TYPES.each{|t| -%>
      subroutine write_array<%= t %>(arrayDir, array<%= list(NUM_DESC_MAX, ''){|i| ", desc#{i}"} %>)
         character(len = *), intent(in):: arrayDir
         <%= t.declare %>, intent(in):: array
         <%- if NUM_DESC_MAX >= 1 -%>
            character(len = *), intent(in), optional:: <%= list(NUM_DESC_MAX){|i| "desc#{i}"} %>
         <%- end -%>

         character(len = *), parameter:: DATA_TYPE_FOR_SELF = '<%= t %>'
         integer, parameter:: DIM_FOR_SELF = <%= t.dim %>

         character(len = len(DATA_TYPE_FOR_SELF)) dataType
         integer:: dim
         integer:: sizes(1:DIM_FOR_SELF)
         integer:: wU1
         integer:: i

         namelist /array_meta/ dataType, dim, sizes

         ASSERT(sh('mkdir -p ' + trim(arrayDir)))

         open(newunit = wU1, file = s(arrayDir) + '/' + ARRAY_VERSION_FILE, status = 'replace', action = 'write')
         write(wU1, *) VERSION
         close(wU1)

         open(newunit = wU1, file = s(arrayDir) + '/' + ARRAY_DATA_FILE, status = 'replace', action = 'write', form = 'unformatted', access = 'stream')
         write(wU1) array
         close(wU1)

         dataType = DATA_TYPE_FOR_SELF
         dim = DIM_FOR_SELF
         forall(i = 1:dim) sizes(i) = size(array, i)
         open(newunit = wU1, file = s(arrayDir) + '/' + ARRAY_META_FILE, status = 'replace', action = 'write', delim = 'quote')
         write(wU1, nml = array_meta)
         close(wU1)

         open(newunit = wU1, file = s(arrayDir) + '/' + ARRAY_DESCRIPTION_FILE, status = 'replace', action = 'write')
         <%- (1..NUM_DESC_MAX).each{|i| -%>
            if(present(desc<%= i %>)) write(wU1, *) desc<%= i %>
         <%- } -%>
         close(wU1)
      end subroutine write_array<%= t %>

      subroutine read_array<%= t %>(arrayDir, array)
         character(len = *), intent(in):: arrayDir
         <%= t.declare %>, intent(out), allocatable:: array

         integer:: rU1, libIoVersion

         open(newunit = rU1, file = s(arrayDir) + '/' + ARRAY_VERSION_FILE, status = 'old', action = 'read')
         read(rU1, *) libIoVersion
         close(rU1)

         select case(libIoVersion)
         case(1)
            call read_array_v_1(arrayDir, array)
         case default
            RAISE('Unsupported version: ' + trim(str_fixed(libIoVersion)))
         end select
      end subroutine read_array<%= t %>

      subroutine read_array_v_1<%= t %>(arrayDir, array)
         character(len = *), intent(in):: arrayDir
         <%= t.declare %>, intent(out), allocatable:: array

         character(len = *), parameter:: DATA_TYPE_FOR_SELF = '<%= t %>'
         integer, parameter:: DIM_FOR_SELF = <%= t.dim %>
         character(len = <%= TYPES.map{|_| _.to_s.size}.max %>):: dataType
         integer:: dim
         integer:: sizes(1:DIM_FOR_SELF)
         integer:: rU1
         namelist /array_meta/ dataType, dim, sizes

         open(newunit = rU1, file = s(arrayDir) + '/' + ARRAY_META_FILE, status = 'old', action = 'read', delim = 'quote')
         read(rU1, nml = array_meta)

         RAISE_IF(s(dataType) /= DATA_TYPE_FOR_SELF)
         RAISE_IF(dim /= DIM_FOR_SELF)

         close(rU1)

         allocate(array(<%= list(t.dim){|i| "1:sizes(#{i})"} %>))

         open(newunit = rU1, file = s(arrayDir) + '/' + ARRAY_DATA_FILE, status = 'old', action = 'read', form = 'unformatted', access = 'stream')
         read(rU1) array
      end subroutine read_array_v_1<%= t %>
   <%- } -%>
end module io_lib