December 5, 2016

Buster

jerem.

I created a way to parse input files to Fotran more flexibly. The code is available in a dedicated git repository. In this post, I go through some of the details of most of the code blocks.

Fortran is the first programming language that I was taught at University. I grew tired of it when I was introduced to more flexible languages like Python but as I got older, I found myself going back to Fortran, principally for the feeling of solidity that it provides.

There one thing, however, which I find very frustrating with it, and it's the absence of an easy and flexible way to parse input from a file.

One way to go around the problem would be to use a more script-oriented language to process the input and then feed it into your actual code.

When I was writing my PhD, I wrote a piece of code to avoid that step and parse my input directly to Fortran. It now has its own git repository for anyone that would interested.

I now present a small description of each code blocks:

We start by defining a custom type with one component that will give a name to the list of input and another one to store all the values

type inputtype
     character(len=30) :: name
     character(len=100), allocatable, dimension(:) :: val
end type inputtype
type(inputtype), allocatable, dimension(:) :: input

Then the following routine goes through the input file and counts the number of inputs ignoring blank lines and comment lines starting with a '#'

contains
  subroutine read_input(input_file)
    implicit none
    character(len=*), intent(in) :: input_file
    character(len=2048) :: buffer, label, str, fmt
    integer :: pos, ios, cnt, i, numb_input

    ios = 0
    cnt = 0
    i = 1
    numb_input = 0

    open(10,file=input_file,status='old')

    do while (ios == 0) ! count the number of inputs
       read(10, '(A)', iostat=ios) buffer
       if(ios == 0)then

          ! Find the first instance of whitespace. Split label and data.
          pos = scan(buffer, ' ')
          label = buffer(1:pos)

          if((label=='') .or. (label( :1)=='#'))cycle  ! skip line if blank or commented with '#'
          numb_input = numb_input + 1
       endif
    end do
    rewind(10)
    ios = 0  

    allocate(input(numb_input))  

Then we go through the file again, collect the input and commit them to memory with the appropriate type defined above.

do while (ios == 0) ! read input
   read(10, '(A)', iostat=ios) buffer
   if(ios == 0)then

      ! Find the first instance of whitespace. Split label and data.
      pos = scan(buffer, ' ')
      label = buffer(1:pos)
      buffer = buffer(pos+1:)

      if((label=='') .or. (label( :1)=='#'))cycle  ! skip line if blank or commented with '#'

      str = buffer

      fmt = '(a'
      cnt = 0
      do while((pos/=0).and.(pos/=1))
         pos = scan(trim(adjustl(str)), ' ')
         str = trim(adjustl(str(pos+1:)))
         cnt = cnt + 1
         fmt = trim(adjustl(fmt)) // ',X,a'
      enddo

      fmt = trim(adjustl(fmt)) // ')'

      input(i)%name = label
      allocate(input(i)%val(cnt))
      if(cnt==1)then
         read(buffer, '(a)', iostat=ios) input(i)%val
      else
         read(buffer, trim(adjustl(fmt)), iostat=ios) input(i)%val
         read(buffer, *, iostat=ios) input(i)%val
      end if

      i=i+1

   endif
end do
close(10)

The rest of the file consists in functions to assign an input to a specific variable with a specific type. Here is the one to assign the input value to a double precision real number.
The functions takes two arguments on top of the variable's name. If there is only one input in the list, the variable provided as the first argument gets populated with the corresponding value and the second one is returned as an empty array. In case there is more than one input, it goes the other way around and it is the variable in the second arguments that gets populated. I am not sure if there is a way to avoid that trick ...

subroutine assign_real(var,var_array,name)
  implicit none
  real(kind=8), intent(out) :: var
  real(kind=8), allocatable, dimension(:), intent(inout) :: var_array
  character(len=*), intent(in) :: name
  integer :: i, j
  logical :: flag

  flag = .false.
  do i=1, size(input)
     if(input(i)%name==name) then
        allocate(var_array(size(input(i)%val)))
        do j=1, size(input(i)%val)
           !print*,input(i)%name,trim(adjustl(input(i)%val(j)))
           read(input(i)%val(j),*) var_array(j)
        enddo
        flag = .true.
     end if
  enddo
  if(flag.eqv..false.) then
     allocate(var_array(0))
     print*, 'Warning : no matching of label "', trim(adjustl(name)), '" found in input file'
  endif

  var = 0d0
  if(size(var_array)==1) then
     var = var_array(1)
  endif
end subroutine assign_real

The git repository contains an easy example presenting all the features.