Upload New File

Sonderuebung/SoSe2024/SU03_2024_04_24/01_routenplaner.f95

+module routenplaner_mod
+    implicit none
+
+    private
+    public :: route_cycle, build_route, delete_route, ausgabe_route, laufzeit
+
+    type todo_task
+        character (20) :: task
+        type(todo_task), pointer :: next => NULL()
+    end type
+
+    type todo_list
+        type(todo_task), pointer :: head => NULL()
+    end type
+
+    type place
+        character (20) :: name
+        type(todo_list) :: todo    
+        integer :: next_time = 0
+        type(place), pointer :: next => NULL()
+    end type
+
+    type route_cycle
+        character (20) :: name
+        type(place), pointer :: start => NULL()
+    end type
+        
+ contains
+
+ ! Aufbau
+    subroutine build_todo_list (list)
+        type(todo_list), intent(inout) :: list
+        type(todo_task), pointer :: current
+        character :: yesno
+        allocate(list%head)
+        current => list%head
+        do
+            write(*,*) "Was soll gemacht werden?"
+            read(*,*) current%task
+
+            write(*,*) "Soll noch eine Aufgabe hinzugefuegt werden? (y/n)"
+            read(*,*) yesno
+            if (yesno /= "y") exit
+
+            allocate(current%next)
+            current => current%next
+        end do
+        
+    end subroutine build_todo_list 
+
+    subroutine insert_place (current)
+        ! fügt einen neuen Ort hinter CURRENT ein
+        ! bei Rückgabe zeigt CURRENT auf den neuen Ort
+
+        type(place), pointer, intent(inout) :: current
+        character :: yesno
+
+        write(*,*) "Wie lange dauert es zu diesem Ort zu kommen? (in Minuten)"
+        read(*,*) current%next_time
+
+        allocate(current%next)
+        current => current%next
+
+        write(*,*) "Wie heisst der neue Ort?"
+        read(*,*) current%Name
+
+        write(*,*) "Soll eine TODO Liste fuer ", trim(current%name), " angelegt werden? (y/n)"
+        read(*,*) yesno
+        if (yesno == "y") call build_todo_list(current%todo)
+        
+    end subroutine insert_place
+
+    subroutine build_route (route)
+        type(route_cycle), intent(out) :: route
+        type(place), pointer :: current => NULL()
+        character :: yesno
+
+        write(*,*) "Wie heisst die Route?"
+        read(*,*) route%name
+
+        allocate(route%start)
+
+        ! erstes Element einlesen
+        write(*,*) "Wie heisst das erste Ziel?"
+        read(*,*) route%start%name
+
+                write(*,*) "Soll eine TODO Liste fuer ", trim(route%start%name), " angelegt werden? (y/n)"
+        read(*,*) yesno
+        if (yesno == "y") call build_todo_list(route%start%todo)
+
+        current => route%start
+
+        ! weitere Elemente einlesen
+        do
+            write(*,*) "Soll ein weiterer Ort zu der Route hinzugefuegt werden? (y/n)"
+            read(*,*) yesno
+            if (yesno /= "y") exit
+
+            call insert_place(current)
+        end do
+
+        ! zyklus schließen
+        write(*,'(A,A,A)') "Wie lange dauert es zu Start ", trim(route%start%name), " zurueck zu kommen? (in Minuten)"
+        read(*,*) current%next_time
+        current%next => route%start
+    
+    end subroutine build_route 
+
+ ! Löschen
+    subroutine delete_todo_list (list)
+        type(todo_list), intent(inout) :: list
+        type(todo_task), pointer :: current, help
+
+        current => list%head
+write(*,*) 115
+        list%head => NULL()
+
+        do while (associated(current))
+            help => current%next
+write(*,*) 120
+            deallocate(current)
+write(*,*) 122
+            current => help
+        end do
+    
+    end subroutine delete_todo_list 
+
+    subroutine delete_route (route)
+        type(route_cycle), intent(inout) :: route
+        type(place), pointer:: help
+        
+        do while (.not. associated(route%start, route%start%next))
+            help => route%start%next
+            route%start%next => route%start%next%next
+
+            call delete_todo_list(help%todo)
+            deallocate(help)
+        end do
+
+        call delete_todo_list (route%start%todo)
+        deallocate(route%start)
+
+        route%start => NULL()
+
+    end subroutine delete_route
+
+ ! Utility
+    subroutine ausgabe_todo_list (list)
+        type(todo_list), intent(in) :: list
+        type(todo_task), pointer ::  current
+
+        current => list%head
+
+        if (associated(current)) then
+            write(*,*) "Es sind folgende Aufgaben zu erledigen:"
+
+            do while (associated(current))
+                write(*,*) current%task
+                current => current%next
+            end do
+
+        else
+            write(*,*) "Es sind keine Aufgaben zu erledigen."
+        end if
+        
+    end subroutine ausgabe_todo_list
+
+    subroutine ausgabe_route (route)
+        type(route_cycle), intent(in) :: route
+        type(place), pointer ::  current
+
+        current => route%start
+
+        do 
+            write(*,'(A,A,A,I4,A)') "Der nächste Ort ist ", trim(current%name), " in ", current%next_time, " Minuten."
+            call ausgabe_todo_list(current%todo)
+
+            current => current%next
+            if (associated(current, route%start)) exit
+        end do
+
+        write(*,*) "Die Route ist nun fertig."
+    
+    end subroutine ausgabe_route 
+
+    function laufzeit (route)
+        type(route_cycle), intent(in) :: route
+        type(place), pointer :: current
+        integer :: laufzeit ! rückgabewert
+
+        current => route%start
+        laufzeit = 0
+
+        do 
+            laufzeit = laufzeit + current%next_time
+            current => current%next
+            if (associated(current, route%start)) exit
+        end do
+
+    end function
+
+end module routenplaner_mod
+
+program main
+    use routenplaner_mod
+    implicit none
+
+    type(route_cycle) :: route
+
+    call build_route(route)
+    call ausgabe_route(route)
+    write(*,'(A,I4,A)') "Die Laufzeit zwischen den Orten der Route betraegt insgesamt ", laufzeit(route), " Minuten."
+    call delete_route(route)
+    
+end program main
\ No newline at end of file