module modul1
implicit none
save
! private-Elemente sind nur im Modul selbst sichtbar (alle anderen sind
! automatisch public)
private :: calc_abc, calc_norm, calc_circumference, calc_angles, calc_area, &
calc_out, calc_in, calc_cog
real, parameter :: PI = 3.1415927
real, dimension(2) :: p1, p2, p3 ! Ortsvektoren für P1,P2,P3
real, dimension(2) :: a, b, c ! Vektoren a, b, c
real, dimension(2) :: x_out, x_in, x_cog ! Ortsvektoren für Umkreis-,
! Inkreismittelpunkt,
! Schwerpunkt
real :: ab_angle, ac_angle, bc_angle ! Winkeln
real :: a_norm, b_norm, c_norm ! Seitenlängen
real :: area, circumference ! Fläche, Umfang
real :: r_out, r_in ! Umkreis-, Inkreisradius
contains
subroutine input
write (*,"(/ A /)") "********** DREIECKSBERECHNUNG **********"
write (*, "(A)") " Eingabe:"
write (*, "(A, $)") " Punkt 1 (x y): "
read (*, *) p1
write (*, "(A, $)") " Punkt 2 (x y): "
read (*, *) p2
write (*, "(A, $)") " Punkt 3 (x y): "
read (*, *) p3
end subroutine input
subroutine calculate
call calc_abc
call calc_norm
call calc_circumference
call calc_angles
call calc_area
call calc_out
call calc_in
call calc_cog
end subroutine calculate
subroutine calc_abc
a = p3 - p1
b = p2 - p1
c = b - a
end subroutine calc_abc
subroutine calc_norm
a_norm = sqrt(sum(a**2))
b_norm = sqrt(sum(b**2))
c_norm = sqrt(sum(c**2))
! Wenn eine Seitenlänge <= epsilon -> kein Dreieck -> Programmabbruch
if (a_norm<=epsilon(a_norm) .OR. b_norm<=epsilon(b_norm) .OR. &
c_norm<=epsilon(c_norm)) then
write(*,"(/, A, /)") "Programmabbruch -> Entartetes Dreieck! (1)"
stop
end if
end subroutine calc_norm
subroutine calc_circumference
circumference = a_norm + b_norm + c_norm
end subroutine calc_circumference
subroutine calc_angles
ab_angle = acos(dot_product(a, b) / (a_norm * b_norm))
bc_angle = acos(dot_product(b, c) / (b_norm * c_norm))
ac_angle = PI - bc_angle - ab_angle
! Wenn ein Winkel <= epsilon -> kein Dreieck -> Programmabbruch
if (ab_angle<=epsilon(ab_angle) .OR. ac_angle<=epsilon(ac_angle) .OR. &
bc_angle<=epsilon(bc_angle)) then
write(*,"(/, A, /)") "Programmabbruch -> Entartetes Dreieck ! (2)"
stop
end if
end subroutine calc_angles
subroutine calc_area
area = a_norm * b_norm * sin(ab_angle) / 2.0
end subroutine calc_area
subroutine calc_out
implicit none
real, dimension(2) :: n, m, x
real :: t2
n = sqrt(1. / (a(1)**2+a(2)**2)) * (/-a(2), a(1)/)
m = sqrt(1. / (b(1)**2+b(2)**2)) * (/-b(2), b(1)/)
t2 = ( n(1)*(a(2)-b(2)) + n(2)*(b(1)-a(1)) ) / &
( 2 * (m(2)*n(1) - m(1)*n(2)) )
x = b/2 + t2 * m
r_out = sqrt(sum(x**2))
x_out = p1 + x
end subroutine calc_out
subroutine calc_in
real, dimension(2) :: v, w
real :: t2
v = 0.5 * (a/a_norm + b/b_norm)
w = 0.5 * (b/b_norm + c/c_norm)
t2 = (b(1)*v(2) -b(2)*v(1)) / (w(2)*v(1) - w(1)*v(2))
x_in = p2 + t2*w
r_in = 2.0 * area / (a_norm + b_norm + c_norm)
end subroutine calc_in
subroutine calc_cog
real, dimension(2) :: v, w
real :: t2
v = a + c/2
w = b/2 -a
t2 = (a(1)*v(2) - a(2)*v(1)) / (w(2)*v(1) - w(1)*v(2))
x_cog = p1 + a + t2*w
end subroutine calc_cog
subroutine output
write (*, "(/ A )") "*** Ergebnisse ***"
write (*,*) " Eingabe:"
write (*,*) " P1 = ", p1
write (*,*) " P2 = ", p2
write (*,*) " P3 = ", p3
write (*,*) " Berechnet:"
write (*,*) " a = ", a
write (*,*) " b = ", b
write (*,*) " c = ", c
write (*,*) " Länge a = ", a_norm
write (*,*) " Länge b = ", b_norm
write (*,*) " Länge c = ", c_norm
write (*,*) " Umfang = ", circumference
write (*,*) " Winkel ab = ", ab_angle, "rad"
write (*,*) " Winkel ab = ", ab_angle * 180.0 /PI, "°"
write (*,*) " Winkel ac = ", ac_angle, "rad"
write (*,*) " Winkel ac = ", ac_angle * 180.0 /PI, "°"
write (*,*) " Winkel bc = ", bc_angle, "rad"
write (*,*) " Winkel bc = ", bc_angle * 180.0 /PI, "°"
write (*,*) " Fläche = ", area, "^2"
write (*,*) " Umkreismittelpunkt = ", x_out
write (*,*) " Umkreisradius = ", r_out
write (*,*) " Inkreismittelpunkt = ", x_in
write (*,*) " Inkreisradius = ", r_in
write (*,*) " Schwerpunkt = ", x_cog
end subroutine output
end module modul1
