Untitled

 avatar
unknown
fortran
a year ago
4.5 kB
13
Indexable
 !** Convert an optional variable length string into an integral representation of a boolean.
  !? Exi stands for exists.
  integer function exi(input) result(integer_representation)
    implicit none

    character(len = *), intent(in), optional :: input

    if (present(input)) then
      integer_representation = 1
    else
      integer_representation = 0
    end if
  end function exi


  !** Helper function for heap_string_array
  ! Basically a HUGE chain of if then statements simplified into call.
  subroutine assign_heap_array(arr, slot, data)
    implicit none

    type(heap_string), dimension(:), intent(inout), allocatable :: arr
    integer, intent(in) :: slot
    character(len = *), intent(in), optional :: data

    if (present(data)) then
      arr(slot) = data
    end if
  end subroutine assign_heap_array


  !** Create an array of dynamically sized strings.
  !** Can take upto 26 elements cause I ran out of letters.
  !! This is a substitute for not having varargs.
  function heap_string_array(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) result(heap_array)
    implicit none

    character(len = *), intent(in), optional :: a
    character(len = *), intent(in), optional :: b
    character(len = *), intent(in), optional :: c
    character(len = *), intent(in), optional :: d
    character(len = *), intent(in), optional :: e
    character(len = *), intent(in), optional :: f
    character(len = *), intent(in), optional :: g
    character(len = *), intent(in), optional :: h
    character(len = *), intent(in), optional :: i
    character(len = *), intent(in), optional :: j
    character(len = *), intent(in), optional :: k
    character(len = *), intent(in), optional :: l
    character(len = *), intent(in), optional :: m
    character(len = *), intent(in), optional :: n
    character(len = *), intent(in), optional :: o
    character(len = *), intent(in), optional :: p
    character(len = *), intent(in), optional :: q
    character(len = *), intent(in), optional :: r
    character(len = *), intent(in), optional :: s
    character(len = *), intent(in), optional :: t
    character(len = *), intent(in), optional :: u
    character(len = *), intent(in), optional :: v
    character(len = *), intent(in), optional :: w
    character(len = *), intent(in), optional :: x
    character(len = *), intent(in), optional :: y
    character(len = *), intent(in), optional :: z
    !? Because we need to allocate with unknown width, we must allow this to live in the heap.
    !? This also basically points to other objects in the heap as well.
    type(heap_string), dimension(:), allocatable :: heap_array
    ! integer :: int

    ! Now we only allocate how much we need.
    allocate(heap_array(exi(a)+exi(b)+exi(c)+exi(d)+exi(e)+exi(f)+exi(g)+exi(h)+exi(i)+exi(j)+exi(k)+exi(l)+exi(m)+exi(n)+exi(o)+exi(p)+exi(q)+exi(r)+exi(s)+exi(t)+exi(u)+exi(v)+exi(w)+exi(x)+exi(y)+exi(z)))

    call assign_heap_array(heap_array, 1, a)
    call assign_heap_array(heap_array, 2, b)
    call assign_heap_array(heap_array, 3, c)
    call assign_heap_array(heap_array, 4, d)
    call assign_heap_array(heap_array, 5, e)
    call assign_heap_array(heap_array, 6, f)
    call assign_heap_array(heap_array, 7, g)
    call assign_heap_array(heap_array, 8, h)
    call assign_heap_array(heap_array, 9, i)
    call assign_heap_array(heap_array, 10, j)
    call assign_heap_array(heap_array, 11, k)
    call assign_heap_array(heap_array, 12, l)
    call assign_heap_array(heap_array, 13, m)
    call assign_heap_array(heap_array, 14, n)
    call assign_heap_array(heap_array, 15, o)
    call assign_heap_array(heap_array, 16, p)
    call assign_heap_array(heap_array, 17, q)
    call assign_heap_array(heap_array, 18, r)
    call assign_heap_array(heap_array, 19, s)
    call assign_heap_array(heap_array, 20, t)
    call assign_heap_array(heap_array, 21, u)
    call assign_heap_array(heap_array, 22, v)
    call assign_heap_array(heap_array, 23, w)
    call assign_heap_array(heap_array, 24, x)
    call assign_heap_array(heap_array, 25, y)
    call assign_heap_array(heap_array, 26, z)

    ! do int = 1,size(heap_array)
    !   print*,heap_array(int)%get()
    ! end do
  end function heap_string_array




! Then you can call it like this
  call create_attribute_locations(heap_string_array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26"))
Editor is loading...
Leave a Comment