Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
P
PROG-material-public
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Walter, Wolfgang
PROG-material-public
Commits
0a26d8b8
Commit
0a26d8b8
authored
11 months ago
by
dali662d
Browse files
Options
Downloads
Patches
Plain Diff
Upload New File
parent
d8fa89a9
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
Sonderuebung/SoSe2024/SU04_2024_05_08/01_routenplaner.f95
+286
-0
286 additions, 0 deletions
Sonderuebung/SoSe2024/SU04_2024_05_08/01_routenplaner.f95
with
286 additions
and
0 deletions
Sonderuebung/SoSe2024/SU04_2024_05_08/01_routenplaner.f95
0 → 100644
+
286
−
0
View file @
0a26d8b8
module
routenplaner_mod
implicit
none
private
public
::
route_cycle
,
build_route
,
delete_route
,
ausgabe_route
,
laufzeit_gesamt
,
search_place
,
place
type
todo_task
character
(
20
)
::
task
integer
::
time
=
0
type
(
todo_task
),
pointer
::
next
=>
NULL
()
end
type
type
todo_list
type
(
todo_task
),
pointer
::
head
=>
NULL
()
integer
::
laenge
=
0
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
(
*
,
*
)
"Wie lange dauert die Aufgabe?"
read
(
*
,
*
)
current
%
time
list
%
laenge
=
list
%
laenge
+
1
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
type
(
place
),
pointer
::
help
character
::
yesno
write
(
*
,
*
)
"Wie lange dauert es zu diesem Ort zu kommen? (in Minuten)"
read
(
*
,
*
)
current
%
next_time
! neues Element einfügen und korrekt verknüpfen
allocate
(
help
)
help
%
next
=>
current
%
next
current
%
next
=>
help
! neues Element einlesen
current
=>
help
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
)
route
%
start
%
next
=>
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
! letzte Laufzeit noch einlesen
write
(
*
,
'(A,A,A)'
)
"Wie lange dauert es zu Start "
,
trim
(
route
%
start
%
name
),
" zurueck zu kommen? (in Minuten)"
read
(
*
,
*
)
current
%
next_time
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
list
%
head
=>
NULL
()
do
while
(
associated
(
current
))
help
=>
current
%
next
deallocate
(
current
)
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
write
(
*
,
*
)
current
=>
route
%
start
do
write
(
*
,
'(A,A,A,I4,A)'
)
"Der naechste 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."
write
(
*
,
*
)
end
subroutine
ausgabe_route
function
laufzeit_todo
(
list
)
result
(
laufzeit
)
type
(
todo_list
),
intent
(
in
)
::
list
type
(
todo_task
),
pointer
::
current
integer
::
laufzeit
laufzeit
=
0
current
=>
list
%
head
do
while
(
associated
(
current
))
laufzeit
=
laufzeit
+
current
%
time
current
=>
current
%
next
end
do
end
function
laufzeit_todo
function
laufzeit_gesamt
(
route
)
result
(
laufzeit
)
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
! + laufzeit_todo(current%todo)
current
=>
current
%
next
if
(
associated
(
current
,
route
%
start
))
exit
end
do
end
function
function
search_place
(
route
)
result
(
ort
)
type
(
route_cycle
),
intent
(
in
)
::
route
type
(
place
),
pointer
::
current
type
(
place
),
pointer
::
ort
character
(
20
)
::
tester
ort
=>
NULL
()
if
(
associated
(
route
%
start
))
then
write
(
*
,
*
)
"Nach welchem Ort soll gesucht werden?"
read
(
*
,
*
)
tester
current
=>
route
%
start
if
(
current
%
name
==
tester
)
ort
=>
current
current
=>
current
%
next
do
while
(
.not.
associated
(
current
,
route
%
start
))
if
(
current
%
name
==
tester
)
then
ort
=>
current
exit
end
if
current
=>
current
%
next
end
do
if
(
associated
(
ort
))
then
write
(
*
,
*
)
"Der angegebene Ort wurde gefunden."
else
write
(
*
,
*
)
"Der Ort wurde nicht gefunden."
end
if
else
write
(
*
,
*
)
"Die Route ist leer."
end
if
end
function
search_place
end
module
routenplaner_mod
program
main
use
routenplaner_mod
implicit
none
type
(
route_cycle
)
::
route
type
(
place
),
pointer
::
ort
call
build_route
(
route
)
call
ausgabe_route
(
route
)
write
(
*
,
'(A,I4,A)'
)
"Die Laufzeit zwischen den Orten der Route betraegt insgesamt "
,
laufzeit_gesamt
(
route
),
" Minuten."
ort
=>
search_place
(
route
)
call
delete_route
(
route
)
end
program
main
\ No newline at end of file
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment