program main

 implicit none

 integer              :: n,mm,i,j
 real*8,  allocatable :: a(:,:),b(:,:),c(:,:)
 integer, allocatable :: d(:)
 real*8               :: na,nb
 logical              :: lnorm

 type list
      integer               :: c1
      real*8                :: c2
      type (list), pointer  :: next
 end type list        

 type (list), pointer  :: head,tail,ptr

 !1)
 do 
   write(*,*) 'Dimension n>1'
   read(*,*) n
   if (n.gt.1) exit
 enddo

 allocate(a(n,n),b(n,n),c(n,n))

 do i=1,n
    do j=1,n
       read(*,*) a(i,j),b(i,j)
    enddo
 enddo   

 !2)
 call norm(a,b,n,na,nb)
 if (na.eq.nb) then
    write(*,*) "A and B get the same norm"
    lnorm=.true.
 else   
    write(*,*) "A and B do not get the same norm"
    lnorm=.false. 
 endif        

 !3)
 call define_c(lnorm,a,b,n,na,nb,c)

 !4)
 mm=n*(n-1)/2+n
 allocate(d(mm))

 call define_d(c,n,mm,d)
 call sort_d(d,mm)


 !5)
 nullify(head,tail)
 do i=1,mm
   if (.not.associated(head)) then
      allocate(head)
      tail => head
      nullify(tail%next)
      tail%c1=d(i)
      tail%c2=dble(d(i)**2)/dble(mm)
   else
      allocate(tail%next)
      tail => tail%next
      nullify(tail%next)
      tail%c1=d(i)
      tail%c2=dble(d(i)**2)/dble(mm)
   endif
 enddo

 !6)

 open(10,file='norm.dat')
 write(10,'("Norm of A is", F10.3,", norm of B is", F10.3)') na, nb
 close(10)

 open(10,file='c.dat')
 do i=1,n
    do j=1,n
       write(10,95) i,j,c(i,j)
    enddo
 enddo    
 close(10)

 open(10,file='d.dat')
 do i=1,mm
    write(10,98) i,d(i)
 enddo
 close(10)
 

 open(10,file='list.dat')
 ptr => head
 do
    if (.not.associated(ptr)) exit
    write(10,100) ptr%c1,ptr%c2
    ptr => ptr%next
 enddo
 close(10)

 deallocate(a,b,c)
 deallocate(d)

95  format(I5,I5,F10.3)
98  format(2(I5))
100 format(I5,F10.3) 

 stop

end program main      



subroutine norm(a,b,n,na,nb)
 
 implicit none

 integer, intent(in)  :: n
 real*8,  intent(in)  :: a(n,n),b(n,n)
 real*8,  intent(out) :: na, nb

 integer              :: i,j

 na=0.d0
 nb=0.d0
 do i=1,n
    do j=1,n
       na=na+abs(a(i,j))**2
       nb=nb+abs(b(i,j))**2 
    enddo
 enddo   
 na=dsqrt(na)
 nb=dsqrt(nb)

 return 

end subroutine norm        


subroutine define_c(lnorm,a,b,n,na,nb,c)

 implicit none

 integer, intent(in)  :: n
 real*8,  intent(in)  :: a(n,n),b(n,n)
 real*8,  intent(in)  :: na, nb
 logical, intent(in)  :: lnorm
 real*8,  intent(out) :: c(n,n)

 integer              :: i,j
 real*8               :: cc

 c=0.d0
 if (lnorm) then
    do i=1,n
       do j=1,n
          if (a(i,j)*b(i,j).gt.0.d0) then
             c(i,j) = a(i,j) + b(i,j) + na
          else
             c(i,j) = a(i,j) - b(i,j)      
          endif        
       enddo
    enddo   
 else
    cc=abs(na-nb)     
    do i=1,n
       do j=1,n
          if (j.eq.i) then
              c(i,j) = cc 
          elseif (j.eq.i+1) then
              c(i,j) = dble(i+j) - cc
          elseif (j.eq.i-1) then
              c(i,j) = cc - dble(i+j)
          endif
       enddo   
    enddo   
 endif

 return 

end subroutine define_c       


subroutine define_d(c,n,mm,d)

 implicit none

 integer,  intent(in)  :: n,mm
 real*8,   intent(in)  :: c(n,n)
 integer,  intent(out) :: d(mm)

 integer               :: i,j,k

 k=0
 do i=1,n
    do j=i,n
       k=k+1
       d(k) = int(c(i,j))
    enddo
 enddo   

 return

end subroutine define_d        


subroutine sort_d(d,mm)

 implicit none

 integer,  intent(in)    :: mm
 integer,  intent(inout) :: d(mm)

 integer                 :: i,j,mdim,tmp

 mdim=int(mm/2)
 do i=1,mdim-1
    do j=2,mdim-(i-1)
       if (d(j-1).gt.d(j)) then
          tmp=d(j-1)
          d(j-1)=d(j)
          d(j)=tmp
       endif
    enddo
 enddo

 return

end subroutine sort_d