bedarf_0001.txt;====== Definition 1 ======;====== ;Definition 1; ======
bedarf_0002.txt;====== ef ======;====== ;ef; ======
bedarf_0003.txt;====== Definition 3 ======;====== ;Definition 3; ======
bedarf_04.txt;====== Def 4 ======;====== ;Definition 4; ======
bedarf_0005.txt;====== Test ======;====== ;Test; ======
bedarf_0006.txt;====== Definition 6 ======;====== ;Definition 6; ======
bedarf_0007.txt;====== Definition 7 ======;====== ;Definition 7; ======
bedarf_0008.txt;====== Definition 8 ======;====== ;Definition 8; ======
bedarf_0009.txt;====== Definition 9 ======;====== ;Definition 9; ======

program read_csv
    use iso_fortran_env
    implicit none

    character(len=*), parameter :: file_name = 'datei.csv'
    character(len=*), parameter :: format_read_line = '(A)'
    character(len=*), parameter :: format_write_line= '(A20, ";", A30)'
    character(len=*), parameter :: format_error_open= '("cannot open file: ", A)'

    character(len=256) :: error_msg, line, s1, s2
    integer :: file_handle, error

    open (NEWUNIT=file_handle, FILE=file_name, STATUS='old', ACTION='READ', IOMSG=error_msg, IOSTAT=error)

    if (0 /= error) then
        write (UNIT=error_unit, FMT=format_error_open) error_msg
        stop
    end if

    do
        read (UNIT=file_handle, FMT=format_read_line, IOSTAT=error) line
        if (0 /= error) exit

        call split_string(line, s1, s2)
        write (output_unit, FMT=format_write_line) s1, s2
    end do

    close(file_handle)
end program

subroutine split_string (s1, s2, s3)
    character(len=*), intent(in) :: s1
    character(len=256), intent(out) :: s2, s3

    character, parameter :: trenner = ';'
    character(len=256) :: substr
    integer :: i

    i = index(s1, trenner)
    s2 = trim(s1(:i-1))

    substr = s1(i+1:)
    i = index(substr, trenner)
    s3 = trim(substr(:i-1))
end subroutine split_string

program doku
  character dn*16, di*26
  integer :: semicolon_index
  open (3,file = 'datei.csv', status = 'old')
  100 read (3,'(a15,1x,a)',end=1000) dn,di
  semicolon_index = INDEX(di, ";") - 1  ! -1 to exclude the semicolon
  open (4,file = dn, status='replace')
  write (4,*) di(1:semicolon_index)
  close(4)
  goto 100
1000 end

! read_csv.f08
! compile with gfortran -std=f2008
program read_csv
    use iso_fortran_env
    implicit none

    character(len=*), parameter :: file_name = 'datei.csv'
    character(len=*), parameter :: format_read_line = '(A)'
    character(len=*), parameter :: format_write_line= '(A, ";", A)'
    character(len=*), parameter :: format_error_open= '("cannot open file: ", A)'

    character(len=256) :: error_msg, line, s1, s2
    integer :: file_handle, error

    open (NEWUNIT=file_handle, FILE=file_name, STATUS='old', ACTION='READ', IOMSG=error_msg, IOSTAT=error)

    if (0 /= error) then
        write (UNIT=error_unit, FMT=format_error_open) error_msg
        stop
    end if

    do
        read (UNIT=file_handle, FMT=format_read_line, IOSTAT=error) line
        if (0 /= error) exit

        call split_string(';', line, s1, s2)
        write (output_unit, FMT=format_write_line) s1(:len_trim(s1)), s2(:len_trim(s2))
    end do

    close(file_handle)
contains
    subroutine split_string (separator, s1, s2, s3)
        character, intent(in) :: separator
        character(len=*), intent(in) :: s1
        character(len=256), intent(out) :: s2, s3

        character(len=256) :: substr
        integer :: i

        i = index(s1, separator)
        s2 = trim(s1(:i-1))

        substr = s1(i+1:)
        i = index(substr, separator)
        s3 = trim(substr(:i-1))
    end subroutine split_string
end program

      program doku
      character line*100
      open(3,file='datei.csv', status='old')
  100 read(3,'(a)',iostat=n) line
      if (n < 0) goto 1000
      i = index(line,';')
      j = index(line(i+1:),';')
      open (4,file = line(1:i-1)//'.txt',status='replace')
      write(4,*) '===== ',trim(line(i+1:i+j-1)),' ====='
      close(4)
      goto 100
 1000 end

module doubly_linked_list
    use iso_fortran_env
    implicit none
    private
    public :: node, list, node_create

    type :: node
        class(*), allocatable, public :: value
        class (node), pointer, private :: prevptr => null(), nextptr => null()
    contains
        procedure, pass, non_overridable :: next => node_next
        procedure, pass, non_overridable :: prev => node_prev

        final :: node_destruct
    end type node

    type :: list
        class (node), pointer, private :: headptr => null(), tailptr => null()
    contains
        procedure, pass, non_overridable :: add_tail => list_add_tail
        procedure, pass, non_overridable :: add_head => list_add_head
        procedure, pass, non_overridable :: delete => list_delete
        procedure, pass, non_overridable :: head => list_head
        procedure, pass, non_overridable :: tail => list_tail

        final :: list_destruct
    end type list
contains
    function node_create (data) result (new_node)
        class (node), pointer :: new_node
        class (*), intent(in) :: data
        integer :: error

        new_node => null()

        allocate (new_node, STAT=error)
        if (0 /= error) then
            write (error_unit,*) 'cannot allocate'
            stop
        end if

        allocate (new_node%value, STAT=error, SOURCE=data)
        if (0 /= error) then
            write (error_unit,*) 'cannot allocate'
            stop
        end if
    end function node_create

    function node_next (this) result (next_node)
        class (node), pointer :: next_node
        class (node) :: this
        
        next_node => this%nextptr
    end function node_next

    function node_prev (this) result (prev_node)
        class (node), pointer :: prev_node
        class (node) :: this

        prev_node => this%prevptr
    end function node_prev

    subroutine node_destruct (this)
        type (node) :: this

        this%nextptr => null()
        this%prevptr => null()
        deallocate(this%value)
    end subroutine node_destruct

    subroutine list_add_tail (this, node_pointer)
        class (list) :: this
        class (node), pointer, intent(in) :: node_pointer

        if (.NOT.associated(this%tailptr)) then
            this%tailptr => node_pointer
            this%headptr => node_pointer
        else
            node_pointer%prevptr => this%tailptr
            node_pointer%nextptr => null()
            this%tailptr => node_pointer
        end if
    end subroutine list_add_tail

    subroutine list_add_head (this, node_pointer)
        class (list) :: this
        class (node), pointer, intent (in) :: node_pointer

        if (.NOT.associated(this%headptr)) then
            this%headptr => node_pointer
            this%tailptr => node_pointer
        else
            node_pointer%nextptr => this%headptr
            node_pointer%prevptr => null()
            this%headptr => node_pointer
        end if
    end subroutine list_add_head

    subroutine list_delete (this)
        class (list) :: this

        type (node), pointer :: p1 => null(), p2 => null()

        p1 => this%headptr
        if (associated(p1)) then
            do

                p2 => p1%nextptr
                p1%nextptr => null()
                p1%prevptr => null()
                deallocate (p1)

                if (.NOT.associated(p2)) then
                    exit
                end if

                p1 => p2
            end do

            this%headptr => null()
            this%tailptr => null()
        end if
    end subroutine list_delete

    subroutine list_destruct (this)
        type (list) :: this

        call this%delete
    end subroutine list_destruct

    function list_head (this) result (node_ptr)
        class (list) :: this
        class (node), pointer :: node_ptr

        node_ptr => this%headptr
    end function list_head

    function list_tail (this) result (node_ptr)
        class (list) :: this
        class (node), pointer :: node_ptr

        node_ptr => this%tailptr
    end function list_tail
end module doubly_linked_list

program doubly_linked_list_test
    implicit none

    type :: my_data
        integer :: number
        integer :: serial
    end type my_data

    type :: my_data2
        integer:: code
    end type my_data2

    call main
contains
    subroutine main
        use doubly_linked_list
        use iso_fortran_env
        implicit none

        type (my_data) :: data1, data2
        type (my_data2) :: data3
        type (list) :: my_list
        type (node), pointer :: a_node

        data1%number = 1
        data1%serial = 1

        data2%number = 1
        data2%serial = 2

        data3%code = -5
    
        a_node => node_create (data1)

        call my_list%add_head (a_node)

        a_node => null()
        a_node => node_create (data2)

        call my_list%add_head (a_node)
        a_node => null()
        
        a_node => node_create (data3)
        call my_list%add_head (a_node)

        a_node => my_list%head ()

        a_node => null()
        data1%serial = 3
        a_node => node_create (data1)

        call my_list%add_tail (a_node)
    end subroutine main
end program doubly_linked_list_test