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

Assignment 1

ASSIGNEMENT ONE

QUESTION 1(i):Print the positive integers from 1 to N greater or equal to 50 with three numbers to a line


!     Last change:  R     2 Mar 2012    8:03 pm
! Question number 1(I) of assignment one
PROGRAM printing_numbers
! it's a program to printing numbers from 1 to N>=50 three numbers to a line
! Input any number greater or equal to 50
PRINT*, ' Input the last Number:'
READ(*,*) N
! Here is printed the output of your desired program
WRITE(*,*)'Here is printed the output of your desired program'
WRITE(*,10)(i,i=1,n)
10 format (3(2x,I3))
END PROGRAM


QUESTION 1(II):

!     Last change:  R     2 Mar 2012    9:27 pm
! Assignment one question no 1(ii)
! the following program solve sum and product of series
program sum_and_product
1 READ(*,*) n
if (n.lt.2) then
PRINT*, 'wrong input, so recheck the condition and input the value of n again'
GOTO 1
end if
summ=0.0
productt=1.0
! now we are going to produce a formula to calculate the sum
! Let initial sum is zero wich is denoted by summ=0.0
! Now follow the loop.
do i=1,n                          ! here i starts from 1
do j=1,i                          ! if i=1 then j=1 then summ=summ+1/float(j)=0+1=1
                                  ! now the current value of summ=1
summ=summ+1.0/float(j)            ! then if i=2 then j=1,2 then summ=summ+1/float(j)
end do                            !                                 =1+(1/1)+(1/2)
end do                            ! in this way we can calculate the rest part of the program
! now we gonna calculate the product of the given series
! Let the initial product is 1.0, note theat if initial product is zero then final result
! will be also zero. to avoid complexities we define initial productt=1.0
! Now follow the loop
do i=1,n                          ! let i=1
summm=0.0                         ! summm=0 and j=1 and loop for i and j both single time
do j=1,i                          ! and then the value of sum and product both will be 1
summm=summm+1.0/float(j)          ! let i=2 then i loop will move single time and loop of j will
end do                            ! move two times
productt=productt*summm
end do
WRITE(*,10) summ,productt
10 format (2x,' the sum is: ',F10.5,//2x,' the product is: ',F10.5)
end program