Eigene Datentypen, Dateien und Genauigkeit

program typen
  implicit none

  type :: punkt
    real :: x = 0.0, y = 0.0
  end type punkt

  type :: person
    character(len=20) :: name
    integer :: alter
    type(punkt) :: ort
  end type person

  type(punkt) :: p
  type(person) :: leute(3)
  integer :: i

  p = punkt(3.0, 4.0)
  print *, p%x, p%y, sqrt(p%x**2 + p%y**2)

  leute(1) = person("Mia", 17, punkt(1.0, 2.0))
  leute(2) = person("Tom", 25, punkt(0.0, 0.0))
  leute(3) = person("Zoe", 31, punkt(5.5, 1.0))
  do i = 1, size(leute)
    print "(a6, i4, 2f7.1)", leute(i)%name, leute(i)%alter, leute(i)%ort%x, leute(i)%ort%y
  end do
  print *, sum(leute%alter) / size(leute)
  print *, maxval(leute%alter), leute(maxloc(leute%alter, dim=1))%name
  leute(2)%alter = leute(2)%alter + 1
  print *, leute(2)%alter
end program typen

3.00000000       4.00000000       5.00000000
Mia     17    1.0    2.0
Tom     25    0.0    0.0
Zoe     31    5.5    1.0
          24
          31 Zoe
          26

module tiere
  implicit none
  type :: tier
    character(len=10) :: name
  contains
    procedure :: laut => tier_laut
    procedure :: vorstellen
  end type tier

  type, extends(tier) :: hund
  contains
    procedure :: laut => hund_laut
  end type hund

contains
  function tier_laut(self) result(s)
    class(tier), intent(in) :: self
    character(len=10) :: s
    s = "..."
  end function
  function hund_laut(self) result(s)
    class(hund), intent(in) :: self
    character(len=10) :: s
    s = "Wuff"
  end function
  subroutine vorstellen(self)
    class(tier), intent(in) :: self
    print "(3a)", trim(self%name), " sagt ", trim(self%laut())
  end subroutine
end module tiere

program zoo
  use tiere
  implicit none
  type(tier) :: t
  type(hund) :: h
  t = tier("Unbekannt")
  h = hund("Rex")
  call t%vorstellen()
  call h%vorstellen()
end program zoo

Unbekannt sagt ...
Rex sagt Wuff

program dateien
  implicit none
  integer :: u, ios, i, n
  real :: x, summe
  character(len=100) :: zeile
  character(len=*), parameter :: datei = "demo.txt"
  logical :: existiert

  open(newunit=u, file=datei, status="replace", action="write")
  write(u, "(a)") "Messwerte"
  do i = 1, 5
    write(u, "(i3, f8.2)") i, i * 1.5
  end do
  close(u)

  open(newunit=u, file=datei, status="old", action="read")
  read(u, "(a)") zeile                         ! Kopfzeile
  print "(a)", trim(zeile)
  summe = 0.0
  n = 0
  do
    read(u, *, iostat=ios) i, x
    if (ios /= 0) exit                         ! Dateiende oder Fehler
    n = n + 1
    summe = summe + x
  end do
  close(u)
  print "(a, i0, a, f0.2)", "Zeilen: ", n, ", Summe: ", summe

  open(newunit=u, file="gibt_es_nicht.txt", status="old", action="read", iostat=ios)
  print *, "Fehlercode beim Öffnen:", ios /= 0

  open(newunit=u, file=datei, status="old")
  close(u, status="delete")                    ! Datei löschen
  inquire(file=datei, exist=existiert)
  print *, "Datei noch da:", existiert
end program dateien

Messwerte
Zeilen: 5, Summe: 22.50
 Fehlercode beim Öffnen: T
 Datei noch da: F

program genauigkeit
  use, intrinsic :: iso_fortran_env, only: sp => real32, dp => real64
  implicit none
  real(sp) :: a
  real(dp) :: b
  integer :: i

  a = 0.1_sp
  b = 0.1_dp
  print *, "einfach:", a
  print *, "doppelt:", b
  print *, "Epsilon:", epsilon(a), epsilon(b)
  print *, "Maximum:", huge(a), huge(b)

  a = 0.0_sp
  b = 0.0_dp
  do i = 1, 1000000
    a = a + 0.1_sp
    b = b + 0.1_dp
  end do
  print "(a, f12.2)", "Summe einfach:", a
  print "(a, f12.2)", "Summe doppelt:", b

  print *, 1.0_dp / 3.0_dp
  print *, sqrt(2.0_dp)**2 == 2.0_dp, abs(sqrt(2.0_dp)**2 - 2.0_dp) < 10 * epsilon(1.0_dp)
  print *, selected_real_kind(15), selected_int_kind(9), selected_int_kind(18)
end program genauigkeit

einfach:  0.100000001
 doppelt:  0.10000000000000001
 Epsilon:   1.19209290E-07   2.2204460492503131E-016
 Maximum:   3.40282347E+38   1.7976931348623157E+308
Summe einfach:   100958.34
Summe doppelt:   100000.00
  0.33333333333333331
 F T
           8           4           8