!! Funktionen zur Matrizenverarbeitung
!! (c) 	6/97 sdteffen

module Matrizen
 implicit none
 contains
                                         
  !! Eine Matrix einlesen
  subroutine readMatrix(Matrix)
    real, pointer , dimension(:,:) :: Matrix
    integer :: nX, nY

    !! Laufvariablen
    integer :: i,j
   
    !! Groesse ermitteln
    write(*,'(A)', advance='no')" Spaltenzahl der Matrix: "
    read(*, *)nX
    write(*,'(A)', advance='no')"Zeilenzahl der Matrix: "
    read(*, *)nY

    !! dynamische Matrize anlegen
    allocate(Matrix(nY, nX),stat=i)
    
    !! Fehler ?  
    if(i.ne.0) stop 'Speicherreservierung nicht moeglich'
    
    do i=1, nY
      do j=1, nX
        write(*,'(i5, A, i5, A)', advance='no')i,". Zeile, ",j,". Spalte: "
        read(*,*)Matrix(i,j)
      end do
    end do
    return
  end subroutine readMatrix

  !!Ergebnis C ist das Produkt der Matrizen A und B  
  subroutine multiplikation(A, B,C)
    real, pointer, dimension(:,:) :: a, b, c
                      
    !! Matrizengroesse
    integer :: l, m, n
    
    !! Laufvariablen     
    integer :: i, j, k

    !! Dimensionen ueberpruefen
    n = size(A, 2) 
    if( n /= size(B, 1)) then
      stop 'Matrizenmultiplikation nicht moeglich, da die Dimensionen nicht korrespondieren'
    end if
    m = size(A, 1)
    l = size(B, 2)

    !! dynamische Matrize anlegen
    allocate(C(m, l),stat=i)
    
    !! Fehler ?  
    if(i /= 0) stop 'Speicherreservierung nicht moeglich'
    
    !! Multiplikation durchfuehren
    do i=1, m
      do j=1, l
        C(i, j) = 0
        do k=1, n
          C(i, j) = C(i,j) + A(i, k) * B(k, j)
        end do
      end do
    end do

    return
   end subroutine multiplikation
  
   !! Gibt Matrix aus
   subroutine writeMatrix(Matrix)
     real, pointer, dimension(:,:) :: Matrix
     
     !! Groesse der Matrix
     integer :: x, y

     !!Laufvariablen
     integer :: i,j

     !! Groesse ermitteln
     y = size(Matrix, 1)
     x = size(Matrix, 2)

     !! Ausgabe
     write(*,*) 
     call writeKlammer(x)
     do i=1, y
      write(*,'(A)',advance='no')' |'
      do j= 1, x
        write(*,'(f11.4)',advance='no')Matrix(i,j)
      end do
      write(*,*)'|'
     end do
     call writeKlammer(x)
    
     return 
   end subroutine writeMatrix
   
   !! gibt den waagerechten Teil der Klammer aus
   subroutine writeKlammer( nSpalten )
      integer, intent(in) :: nSpalten
      character (len = nSpalten * 11 - 1) :: Blanks
      Blanks = ""
      write (*, *)"+-",Blanks,"-+"
      return
    end subroutine writeKlammer


end module Matrizen