utils.f90

View source code here on GitHub!

function  utils/open_data_file(name)

Return the unit number for a newly-opened file in /_data/, where / is the repository root.

Parameters:

id [character(len=DATA_MAX_NAME_SIZE)]

Return:

unit [integer]

function  utils/get_answer(id)

Return the answer to a given problem, as represented in /_data/answers.tsv, where / is the repository root. On first run, it will take O(n) time, where n is the number of problems in the file. From there on out, it should be O(1).

Parameters:

id [integer(i4t)]

Return:

answer [AnswerT]

type  utils/AnswerT

This stores the answer to a generic problem, storing multiple potential types. If the type field contains errort, there was an error in generating the answer. If it is int64t, it holds data of type integer(i18t). If it is stringt, it holds a character array.

Type fields:

  • % type [integer(i1t)]

  • % int_value [integer(i18t)]

  • % string_value [character(len=:f:var:ANSWERT_STR_LEN)]

  1module utils
  2    use constants
  3    implicit none
  4
  5    type :: AnswerT
  6        integer(i18t) :: int_value
  7        character(len=ANSWERT_STR_SIZE) :: string_value
  8        integer(i1t) :: type
  9    end type AnswerT
 10
 11    integer :: prev_unit = 13
 12    logical :: cache_inited = .false.
 13    type(AnswerT), dimension(1024) :: cached_answers
 14contains
 15    integer function open_data_file(name, direct, recl) result(unit)
 16        character(len=DATA_MAX_NAME_SIZE), intent(in) :: name
 17        logical, intent(in), optional :: direct
 18        integer, intent(in), optional :: recl
 19        integer :: ios
 20
 21        unit = prev_unit + 1
 22        prev_unit = unit
 23        if (present(direct) .and. present(recl) .and. direct) then
 24            open(unit=unit, file=("../_data/" // name), status='old', action='read', iostat=ios, access='direct', recl=recl)
 25        else
 26            open(unit=unit, file=("../_data/" // name), status='old', action='read', iostat=ios)
 27        end if
 28        if (ios /= 0) then
 29            print *, "Error opening file: ../_data/" // name
 30            return
 31        end if
 32    end function
 33
 34    type(AnswerT) function get_answer(id) result(answer)
 35        integer(i4t), intent(in) :: id
 36
 37        if (id < 1 .or. id > size(cached_answers)) then
 38            print *, "Error: ID is out of bounds."
 39            answer = AnswerT(0, '', errort)
 40            return
 41        end if
 42
 43        if (.not. cache_inited) then
 44            call init_answer_cache()
 45        end if
 46
 47        answer = cached_answers(id)
 48    end function
 49
 50    subroutine init_answer_cache()
 51        character(len=DATA_MAX_NAME_SIZE), parameter ::file_name = "answers.tsv"
 52        character(len=64) :: line
 53        character(len=32) :: val
 54        character(len=4) :: id_, type_, length
 55        integer(i18t) :: i, j
 56        integer :: ios, line_length, unit_number
 57
 58        cached_answers = AnswerT(0, '', errort)
 59        unit_number = open_data_file(file_name)
 60        line_length = 1
 61        do while (line_length > 0)
 62            line = ''
 63            read(unit_number, '(A)', iostat=ios) line
 64            if (ios /= 0) then
 65                close(unit_number)
 66                exit
 67            end if
 68
 69            line = trim(line)
 70            line_length = len(line)
 71            if (line_length > 0) then
 72                call parse_line(line, id_, type_, length, val)  ! Parse values
 73                if (id_ == "ID") then
 74                    cycle
 75                end if
 76                read(id_, *, iostat=ios) i
 77                if (ios /= 0) then
 78                    print *, "Invalid integer literal for id. Moving on without explicit error, but please debug this"
 79                end if
 80                select case (type_)
 81                    case ("int", "uint")
 82                        read(val, *, iostat=ios) j
 83                        if (ios /= 0) then
 84                            print *, "Invalid integer literal for value. Returning error type"
 85                        else
 86                            cached_answers(i)%type = int64t
 87                            cached_answers(i)%int_value = j
 88                        end if
 89                    case ("str")
 90                        cached_answers(i)%type = stringt
 91                        cached_answers(i)%string_value = trim(val)
 92                    case default
 93                        print *, "Invalid value type. Returning error type"
 94                end select
 95            end if
 96        end do
 97
 98        cache_inited = .true.
 99    end subroutine
100
101    pure subroutine parse_line(line, id_out, type_out, length_out, value_out)
102        character(len=*), intent(in) :: line
103        character(len=32), intent(out) :: value_out
104        character(len=4), intent(out) :: id_out, type_out, length_out
105        integer :: pos, i, last_pos
106    
107        id_out = ''
108        type_out = ''
109        length_out = ''
110        value_out = ''
111        last_pos = 0
112    
113        do i = 1, 4
114            pos = index(line(last_pos + 1:), char(9))  ! Find tab character
115            if (pos == 0) then  ! Tab not found, assign remaining part to the last variable
116                select case (i)
117                    case (1)
118                        id_out = trim(line(last_pos + 1:))
119                    case (2)
120                        type_out = trim(line(last_pos + 1:))
121                    case (3)
122                        length_out = trim(line(last_pos + 1:))
123                    case (4)
124                        value_out = trim(line(last_pos + 1:))
125                        if (len_trim(value_out) > 0) then
126                            if (value_out(len_trim(value_out):len_trim(value_out)) == char(10)) then
127                                value_out = value_out(1:len_trim(value_out) - 1)  ! strip \n
128                            end if
129                            if (value_out(len_trim(value_out):len_trim(value_out)) == char(13)) then
130                                value_out = value_out(1:len_trim(value_out) - 1)  ! strip \r
131                            end if
132                        end if
133                end select
134                return
135            else
136                select case (i)
137                    case (1)
138                        id_out = trim(line(last_pos + 1:last_pos + pos - 1))
139                    case (2)
140                        type_out = trim(line(last_pos + 1:last_pos + pos - 1))
141                    case (3)
142                        length_out = trim(line(last_pos + 1:last_pos + pos - 1))
143                end select
144                last_pos = last_pos + pos
145            end if
146        end do
147    end subroutine parse_line
148end module utils

Tags: file-io