Assignment 3

 The following program solves problem 1,2,3 and 4 together ......




!     Last change:  R    18 May 2011    2:33 am
program matrix_calculation
DIMENSION a(100,100),T(100,100)
Integer::a,n,T                                ! T is identity matrix
OPEN(1,FILE='inp.dat')
OPEN(2,FILE='otp.dat')
READ(1,*)n,((a(i,j),j=1,n),i=1,n), ((T(i,j),j=1,n),i=1,n)
WRITE(2,*)'Matrix A:='
WRITE(2,*)'   '
call mat(a,n)                                 ! Calling subroutine 'mat'
WRITE(2,*)'    '
call add(a,n)                                 ! Calling subroutine 'add'
WRITE(2,*)'    '
call mult(a,n)                                ! Calling subroutine 'mult'
WRITE(2,*)'   '
call trace(a,n)                               ! Calling subroutine 'trace'
WRITE(2,*)'   '
call sumadl(a,n)                              ! Calling subroutine 'sumadl'
WRITE(2,*)'   '
call sumbdl(a,n)                              ! Calling subroutine 'sumadl'
WRITE(2,*)'   '
call sym(a,n)                                 ! Calling subroutine 'sym'
WRITE(2,*)'  '
call asym(a,n)                                ! Calling subroutine 'asym'
WRITE(2,*)'  '
call idm(a,n)                                 ! Calling subroutine 'idm'
WRITE(2,*)'   '
call orth(a,n,T)                              ! Calling subroutine 'orth'
WRITE(2,*)'   '
call inv(a,n,T)                               ! Calling subroutine 'inv'
WRITE(2,*)'  '
call np(a,n)                                  ! Calling subroutine 'np'
CLOSE(1)
CLOSE(2)
stop
end program

! question no.1(i)
subroutine mat(a,n)
DIMENSION a(100,100),b(100,100)
integer::a,b,n
WRITE(2,10)((a(i,j),j=1,n),i=1,n)
10 format (3(2x,I3))
WRITE(2,*)'  '
WRITE(2,*)' Answer to the question no 1(i):'
WRITE(2,*)'----------------------------------  '
WRITE(2,*)' Transpose of Matrix A is given below'
WRITE(2,*)'   '
b=TRANSPOSE(a)
WRITE(2,11)((b(i,j),j=1,n),i=1,n)
11 FORMAT(3(2x,I3))
end subroutine

! question no.1(ii)
subroutine add(a,n)
DIMENSION a(100,100),c(100,100)
integer::a,c,n
do i=1,n
do j=1,n
c(i,j)=a(i,j)+a(j,i)
end do
end do
WRITE(2,*)' Answer to the question no 1(ii):'
WRITE(2,*)'----------------------------------  '
WRITE(2,*)'  '
WRITE(2,*)' Addition of A and transpose of A is given below  '
WRITE(2,*)'   '
WRITE(2,12)((c(i,j),j=1,n),i=1,n)
12 format (3(2x,I3))
end subroutine

! question no.1(iii)
subroutine mult(a,n)
DIMENSION a(100,100),d(100,100)
integer:: a,d,n
d(i,j)=0
do k=1,n
do i=1,n
do j=1,n
d(i,j)=d(i,j)+a(i,k)*a(k,j)
end do
end do
end do
WRITE(2,*)' Answer to the question no 1(iii):'
WRITE(2,*)'----------------------------------  '
WRITE(2,*)' Multiplication of Matrix A and A i.e A^2  '
WRITE(2,*)'    '
WRITE(2,13)((d(i,j),j=1,n),i=1,n)
13 FORMAT(3(2x,I5))
end subroutine

! question no.2(a)
subroutine trace(a,n)
DIMENSION a(100,100)
integer::a,n,tr
tr=0
do i=1,n
tr=tr+a(i,i)
end do
WRITE(2,*)' Answer to the question no 2(a):'
WRITE(2,*)'----------------------------------  '
WRITE(2,*)' '
WRITE(2,*)' Trace of Matrix A is ', tr
end subroutine

! question no.2(b)
subroutine sumadl(a,n)
DIMENSION a(100,100)
integer:: a,n,abdl
abdl=0
do i=1,(n-1)
do j=2,n
IF(i.ne.j)abdl=abdl+a(i,j)
end do
end do
WRITE(2,*)' Answer to the question no 2(b):'
WRITE(2,*)'----------------------------------  '
WRITE(2,*)' Sums the elements above the main diagonal is',abdl
end subroutine

! question no.2(c)
subroutine sumbdl(a,n)
DIMENSION a(100,100)
integer::a,n, bdl
bdl=0
do i=2,n
do j=1,(n-1)
IF(i.ne.j)bdl=bdl+a(i,j)
end do
end do
WRITE(2,*)' Answer to the question no 2(c):'
WRITE(2,*)'----------------------------------  '
WRITE(2,*)'  '
WRITE(2,*)' Sums the elements below the main diagonal line is ',bdl
end subroutine

! question no.3(a)
subroutine sym(a,n)
DIMENSION a(100,100)
integer:: a,n
WRITE(2,*)' Answer to the question no 3(a):'
WRITE(2,*)'----------------------------------  '
do i=1,n
do j=1,n
IF ((a(i,j)).NE.(a(j,i))) then
WRITE(2,*)' A is not symmetric'
return
END if
end do
end do
WRITE(2,*)' A is symmetric '
return
end subroutine

! question no 3(b)
subroutine asym(a,n)
DIMENSION a(100,100)
integer:: a,n
WRITE(2,*)' Answer to the question no 3(b):'
WRITE(2,*)'----------------------------------  '
do i=1,n
do j=1,n
IF ((a(i,j)).ne.(-(a(j,i)))) then
WRITE(2,*)' A is not antisymmetric'
return
END if
end do
end do
WRITE(2,*)' A is antisymmetric '
return
end subroutine

! question no. 4(a)
subroutine idm(a,n)
DIMENSION a(100,100),f(100,100)
INTEGER::a,n,f
WRITE(2,*)' Answer to the question no 4(a):'
WRITE(2,*)'----------------------------------  '
f=MATMUL(a,a)
do i=1,n
do j=1,n
IF ((f(i,j)).ne.(a(i,j))) Then
WRITE(2,*)' A is not Idempotent matrix'
return
END if
end do
end do
WRITE(2,*)' A is Idempotent matrix'
return
end subroutine

! question no. 4(b)

subroutine orth(a,n,T)
DIMENSION a(100,100),T(100,100),g(100,100)
INTEGER::a,T,g,n
WRITE(2,*)' Answer to the question no 4(b):'
WRITE(2,*)'----------------------------------  '
g(i,j)=0
do k=1,n
do i=1,n
do j=1,n
g(i,j)=g(i,j)+a(i,k)*a(j,k)
end do
end do
end do
WRITE(2,*)'  '
WRITE(2,*)' Multiplication of matrix A and Transpose of A is-'
WRITE(2,14) ((g(i,j),j=1,n),i=1,n)
14 FORMAT(3(2x,I5))
do i=1,n
do j=1,n
if ((g(i,j)).NE.(T(i,j))) then
WRITE(2,*)'A is not Orthogonal matrix '
return
end if
end do
end do
WRITE(2,*)' A is Orthogonal Matrix'
end subroutine

! question no. 4(c)
SUBROUTINE inv(a,n,T)
DIMENSION a(100,100),T(100,100),h(100,100)
INTEGER::a,T,h,n
WRITE(2,*)' Answer to the question no 4(c):'
WRITE(2,*)'----------------------------------  '
h=MATMUL(a,a)
do i=1,n
do j=1,n
if ((h(i,j)).NE.(T(i,j))) then
WRITE(2,*)' A is not Involuntary matrix'
return
end if
end do
end do
WRITE(2,*)' A is Involuntary matrix  '
END SUBROUTINE

! question no. 4(d)
subroutine np(a,n)
DIMENSION a(100,100),l(100,100),m(100,100)
INTEGER::a,l,m,n
WRITE(2,*)' Answer to the question no 4(d):'
WRITE(2,*)'----------------------------------  '
l=a
k=2
100 call nilpt(a,n,l,m)
WRITE(2,*) ' Product is :'
WRITE(2,50)((m(i,j),j=1,n),i=1,n)
50 FORMAT(3(2x,I8))
do i=1,n
do j=1,n
IF (m(i,j).ne.0) THEN
WRITE(2,*)' A is not nillpotent matrix'
GOTO 2
END IF
end do
end do
GOTO 3
2 WRITE(2,*)'  '
l=m
IF (k.gt.10) THEN
WRITE(2,*)' Iteration failed'
stop
END IF
k=k+1
GOTO 100
3 WRITE(2,*) ' A is nillpotent',k
return
end subroutine


subroutine nilpt(a,n,l,m)
DIMENSION a(100,100),l(100,100),m(100,100)
INTEGER::a,l,m,n
m(i,j)=0
do k=1,n
do i=1,n
do j=1,n
m(i,j)=m(i,j)+a(i,k)*l(k,j)
end do
end do
end do
end subroutine