      program prod_matmat
C  Programma che legge due matrici, D ed E, calcola F = D*E e G = E*D
C  mediante la subroutine "prodmat", e calcola traccia e norma euclidea
C  di F e G.
C  NB: Vengono utilizzate due volte la stessa subroutine e le stesse
C  function non occorre scriverle due volte!!!!
      implicit none
      integer  n,i,j
      real*8   D(100,100),E(100,100),F(100,100),G(100,100)
      real*8   tr,traccia,norma,eucl
C  Apertura delle unita' di Input/Output
      open(5,file='datimat.dat')
      open(6,file='risulmat.ris')
C  Lettura e stampa della dimensione
      read(5,*) n
      write(6,*) 'n :',n
C  Lettura e stampa di D
      write(6,*) 'Matrice D:'
      do i = 1,n
         read(5,*) (D(i,j),j=1,n)
         write(6,1) (D(i,j),j=1,n)
      enddo
C  Lettura e stampa di E
      write(6,*) 'Matrice E:'
      do i = 1,n
         read(5,*) (E(i,j),j=1,n)
         write(6,1) (E(i,j),j=1,n)
      enddo
C  Calcolo del prodotto F = D*E
      call prodmat(n,D,E,F)
C  Stampa della matrice F
      write(6,*) 'Matrice F = D*E:'
      do i = 1,n
         write(6,1) (F(i,j),j=1,n)
      enddo
C  Calcolo della traccia di F
      tr = traccia(n,F)
C  Calcolo della norma euclidea di F
      norma = eucl(n,F)
C  Stampa della traccia di F
      write(6,*) 'Traccia F:',tr
C  Stampa della norma euclidea di F
      write(6,*) 'Norma Euclidea F:',norma
C  Calcolo del prodotto G = E*D
      call prodmat(n,E,D,G)
C  Stampa della matrice G
      write(6,*) 'Matrice G = E*D:'
      do i = 1,n
         write(6,1) (G(i,j),j=1,n)
      enddo
C  NB: Per il calcolo della traccia di G posso riutilizzare anche le
C  variabili "tr" e "norma", oltre ovviamente alle function e alla
C  subroutine
C  Calcolo della traccia di G
      tr = traccia(n,G)
C  Calcolo della norma euclidea di GF
      norma = eucl(n,G)
C  Stampa della traccia di G
      write(6,*) 'Traccia G:',tr
C  Stampa della norma euclidea di G
      write(6,*) 'Norma Euclidea G:',norma
1     format(5f10.2)
      stop
      end
C
      subroutine prodmat(m,a,b,c)
      implicit none
      integer  m,i,j,k
      real*8   a(100,100),b(100,100),c(100,100)
      do i = 1,m
         do j = 1,m
            c(i,j) = 0.0
            do k = 1,m
               c(i,j) = c(i,j) + a(i,k)*b(k,j)
            enddo
         enddo
      enddo
      return
      end
C
      real*8 function traccia(m,A)
      implicit none
      integer  i,m
      real*8   A(100,100)
      traccia = 0.0
      do i = 1,m
         traccia = traccia + A(i,i)
      enddo
      return
      end
C
      real*8 function eucl(m,A)
      implicit none
      integer  i,j,m
      real*8   A(100,100)
      eucl = 0.0
      do i = 1,m
         do j = 1,m
            eucl = eucl + A(i,j)**2
         enddo
      enddo
      eucl = sqrt(eucl)
      return
      end
