MODULE vektorilaskenta

  IMPLICIT NONE

  TYPE vektorityyppi
    PRIVATE
    REAL :: x, y, z
  END TYPE vektorityyppi

  INTERFACE OPERATOR(+)
    MODULE PROCEDURE vektorisumma
  END INTERFACE

  INTERFACE OPERATOR(-)
    MODULE PROCEDURE vektorierotus
  END INTERFACE

  INTERFACE ABS
    MODULE PROCEDURE vektorinormi
  END INTERFACE

CONTAINS

    FUNCTION vektorisumma(v1, v2) RESULT(summa_vektori)
    ! Palauttaa arvonaan vektoreiden v1 ja v2 summavektorin
      IMPLICIT NONE
      TYPE(vektorityyppi) :: summa_vektori
      TYPE(vektorityyppi), INTENT(IN) :: v1, v2

      summa_vektori % x = v1 % x + v2 % x
      summa_vektori % y = v1 % y + v2 % y
      summa_vektori % z = v1 % z + v2 % z
    END FUNCTION vektorisumma


    FUNCTION vektorierotus(v1, v2) RESULT(erotus_vektori)
    ! Palauttaa arvonaan vektoreiden v1 ja v2 erotusvektorin
      IMPLICIT NONE
      TYPE(vektorityyppi) :: erotus_vektori
      TYPE(vektorityyppi), INTENT(IN) :: v1, v2

      erotus_vektori % x = v1 % x - v2 % x
      erotus_vektori % y = v1 % y - v2 % y
      erotus_vektori % z = v1 % z - v2 % z
    END FUNCTION vektorierotus

    FUNCTION pistetulo(v1, v2) RESULT(tulos)
    ! Palauttaa arvonaan vektoreiden v1 ja v2 pistetulon
      IMPLICIT NONE
      REAL :: tulos
      TYPE(vektorityyppi), INTENT(IN) :: v1, v2

      tulos = v1 % x * v2 % x
      tulos = tulos + v1 % y * v2 % y
      tulos = tulos + v1 % z * v2 % z
    END FUNCTION pistetulo

    FUNCTION vektorinormi( v ) RESULT(pituus)
    ! Palauttaa arvonaan vektorin v pituuden
      IMPLICIT NONE
       TYPE(vektorityyppi), INTENT(IN) :: v
       REAL :: pituus
       pituus = SQRT(pistetulo(v,v))
    END FUNCTION vektorinormi

    FUNCTION ristitulo(v1, v2) RESULT(tulos)
    ! Palauttaa arvonaan vektoreiden v1 ja v2 ristitulon
      IMPLICIT NONE
       TYPE(vektorityyppi) :: tulos
       TYPE(vektorityyppi), INTENT(IN) :: v1, v2

       tulos % x = v1 % y * v2 % z - v1 % z * v2 % y
       tulos % y = v1 % z * v2 % x - v1 % x * v2 % z
       tulos % z = v1 % x * v2 % y - v1 % y * v2 % x
    END FUNCTION ristitulo

    FUNCTION vektori(x, y, z) RESULT(uusi_vektori)
    ! Palauttaa arvonaan vektorin, jonka komponenttien arvot
    ! on annettu argumentteina
      IMPLICIT NONE
      REAL :: x, y, z
      TYPE(vektorityyppi) :: uusi_vektori

      uusi_vektori % x = x
      uusi_vektori % y = y
      uusi_vektori % z = z
    END FUNCTION vektori

  FUNCTION komponentit(vektori) RESULT(tulostaulukko)
  ! Palauttaa vektorin komponenttien arvot taulukossa
    IMPLICIT NONE
    TYPE(vektorityyppi) :: vektori
    REAL, DIMENSION(3) :: tulostaulukko

    tulostaulukko(1) = vektori % x
    tulostaulukko(2) = vektori % y
    tulostaulukko(3) = vektori % z
  END FUNCTION komponentit

END MODULE vektorilaskenta

PROGRAM vektoritesti
  USE vektorilaskenta
  IMPLICIT NONE
  TYPE(vektorityyppi) :: u, v, w
  CHARACTER(LEN=*), PARAMETER :: form = '(A,3F7.3)'
  REAL :: k, pituus

  u = vektori(1.0,0.0,0.0)
  v = vektori(-1.0,1.0,1.0)
  w = ristitulo(u,v)
  k = pistetulo(u,v)
  pituus = ABS(u)

  WRITE(*,form) 'Vektori u: ', komponentit(u)
  WRITE(*,form) 'Vektori v: ', komponentit(v)
  WRITE(*,form) 'Vektorin u pituus: ', pituus
  WRITE(*,form) 'Vektoreiden u ja v ristitulo: ', &
      komponentit(w)
  WRITE(*,form) 'Vektoreiden u ja v pistetulo: ', k
END PROGRAM