Fortran: Anhang B: Dreiecksberechnung: Modul1.f90

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