Perfect Numbers

Write a program to find the Perfect numbers between 1 to 10000 .

Program Coding 

Program Perfect_numbers
Implicit none
    Integer :: i , x , Sum
    write (*,*) "List  of  Perfect Numbers:"
    Do x = 2 , 10000
        Sum = 0
           Do i = 1,x/2
                If ( mod (x,i) == 0) then
                Sum = Sum + i
                 end if
                 end do
             If(x /= Sum) Cycle
            If(x == Sum) then
                    write (*,*) x
                    End if
                 end do
            stop

            end program

    !Output

Maximum And Minimum Value of a function with their location

Write  a  subroutine  that  attempts  to locate  the  maximum  and  minimum  values  of  an  arbitrary  function  over  a  certain  range .  The function  being  evaluated  should  the  passed  to  the  subroutine  as  a calling  argument .

The  main  program  should  pass  to the subroutine  the  function  f(x) = x³ – 5x² +5x +2 and search  for  the  minimum and maximum  in  200 steps  over  the  range  -1 ≤ x ≤ 3 . The Subroutine  should  have  the  following  output  arguments  minimum   value  , location of  minimum value , maximum  value  and  location  of  maximum value  .

Coding

Program Mini_maxi

 Implicit none

 integer :: i, step

 real :: a , b , x(200) , y(200) , f, incr

 Write(*,1) 'Starting Interval :'

 1 format (a20)

 read(*,7) a

 7 format(F10.3)

Write(*,2)'Ending Interval :'

 2 format (a20)

 read(*,10) b

 10 format(F10.3)

 Write(*,3)'Steps :'

 3 format (a8)

 read(*,11) step

 11 format(I4,/)

 Write (*,4)'No.','Values of x','Values of y'

 4 format (a4,5x,a11,6x,a11)

 incr=(b-a)/Float(step -1)

 do i= 1, step

 x(i)= a + (i-1)*incr

 y(i)= x(i)**3 -5*x(i)**2 +5*x(i) +2

 Write (*,5)i, x(i),y(i)

 5 format (i5,5x,f10.6,6x,f10.6)

 end do

 Call sub(x,y)

 end program

subroutine sub(x,y)             ! x and y is x and F(x) value

 implicit none

 integer :: i, j, iptr

 real :: x(200), y(200), min_loc, max_loc, min_val, max_val, s

 min_loc=x(1)

 max_loc=x(1)

 min_val=y(1)

 max_val=y(1)

 do i= 2, 200

 if(y(1)>y(i)) then                         ! finding Minimum

 call sub2(y(1), y(i))

 min_loc=x(i)

 min_val=y(i)

 end if

 end do

 do i= 2, 200

 if(y(1)<y(i)) then                        ! finding Maximum

 call sub2(y(1), y(i))

 max_loc=x(i)

 max_val=y(i)

 end if

 end do

 write(*, 8) "Minimum value =", min_val, ", location =", min_loc

 8 format(/,/,A16, f10.3, A13, F10.3)

 write(*, 9) "Maximum value =", max_val, ", location =", max_loc

 9 format(A16, f10.3, A13, F10.3)

 end subroutine

 subroutine sub2(a,b)

 implicit none

 real :: a, b, s

 s=a

 a=b

 b=s

 end subroutine

Input Data

Output  result ::

Dot Product

Write a program to find the Dot Product of two vectors a and b .

  Program Another_DOt_Product

  Implicit none

    Real , dimension(3) :: a, b

   integer :: i, X, Y

   X = size(a)

   Y = size(b)

   do i = 1, X

      a(i) = i

   end do

   do i = 1, Y

      b(i) = i*2

   end do

   do i = 1, X

      Print *, a(i)

   end do

   do i = 1,Y

      Print *, b(i)

   end do

   Print*, 'Vector Multiplication :'

   print*, ' Dot Product:' , Dot_product(a,b)

end program

Dot and Cross Product

Write a function to evaluate the cross product and dot product of two vectors V₁ and V₂ , where

 V₁ = V_1xi + V_1yj + V_1zk  and  V₂ = V_2xi + V_2yj + V_2zk .

 Note that this function returns a real array as its result .

Use this function to calculate the cross product and dot product of  V₁=[-2 , 4 , 0.5]  and V₂=[0.5 , 3 , 2] .

Program Dot_and_Cross_Product

    implicit none

    Integer :: i

    real :: a(3) , b(3) , dot , crossX , crossY , crossZ

    read(*,*) (a(i),i=1,3)

    read(*,*) (b(i),i=1,3)

    write(*,11) 'Dot Product =' , dot(a,b)

    11 format (A13 , F8.3)

    Write(*,12) 'Cross Product=' , crossX(a,b) , crossY(a,b) , crossZ(a,b)

    12 format ( A14 , f5.2 , 'i+' , f5.2 , 'j' , f5.2, 'k')

    end program

real function dot (a,b)

implicit none

real :: a(3) , b(3)

dot = a(1)*b(1)+a(2)*b(2)+a(3)*b(3)

end function

real function crossX(a,b)

implicit none

real :: a(3) , b(3)

Crossx = b(3)*a(2)-b(2)*a(3)

end function

real function crossY(a,b)

implicit none

real :: a(3) , b(3)

CrossY = b(1)*a(3)-a(1)*b(3)

end function

real function crossZ(a,b)

implicit none

real :: a(3) , b(3)

CrossZ = a(1)*b(2)-a(2)*b(1) 

end function

Transpose

Write a program  to  read  in  2  square  matrices  ( of  any  size ) . Show  that the matrices  follow  the  rule  (AB)^T = B^T A^T where  A^T  is   the  transpose  of  matrix  A .

Program Coding

Program Transpose

 implicit none

 integer :: i, j, k

 integer, parameter :: n=3

 integer :: A(n,n), B(n,n), At(n,n), Bt(n,n),                          AB(n,n),AB_t(n,n),BtAt(n,n)

 open(1, file="input.dat")

 open(2, file="output.dat")

 Do i=1,n

      read(1,7) (A(i, j), j=1,n) ! Input A Matrix

      7 format(/,3(i3,1x))

 end do

 Do i=1,n

      read(1,8) (B(i, j), j=1,n) ! Input B Matrix

     8 format(/,3(i3,1x))

 end do

 call trn(A, At)               ! Transpose of A matrix At

 call trn(B, Bt)               ! Transpose of B matrix Bt

 call prod(A, B, AB)     ! Product of A and B matrix AB

 call trn(AB, AB_t)       !Transpose of AB matrix AB_t

 call prod(Bt, At, BtAt) !Product of B transpose (Bt) and A

transpose (At)

 write(2,9) "Transpose of AB Matrix ="

 9 format(A24)

Do i=1, n

     Write(2,10) (AB_t(i, j), j=1,n)

     10 format(3(i4, 1x))

 end do

 write(2,11) "Product of B transpose and A transpose ="

 11 format(A40)

 Do i=1, n

     Write(2,12) (BtAt(i, j), j=1,n)

    12 format(3(i4, 1x))

 end do

 end program

 subroutine prod(A,B,AB)      !Product of A and B

 integer, parameter :: n=3

 integer :: i,j,k, A(n,n), B(n,n), AB(n,n)

   Do i=1,n

      Do j=1,n

          AB(i, j)=0.0

            Do k=1, n

            AB(i,j)=AB(i,j) + A(i,k)*B(k, j)

           end do

     end do

 end do

 end subroutine

 subroutine trn(A, At)         !Transpose of a matrix

 integer,parameter :: n=3

 integer :: i,j, A(n,n), At(n,n)

 Do i=1,n

    Do j=1,n

       At(i,j)= A(j, i)

     end do

 end do

 end subroutine

Matrices multiplication

Read the following two matrices from an INPUT file 

 i)  Calculate AB

ii) If  A = a_ij  , then  print  an  array  C = ( a_ij )² .


Program Coding 

program   Qu_01

  implicit  none

  integer:: i, j, k

  integer:: A(3,4), B(4,2), AB(3,2), C(3,4)

  open(unit=1, file="input.dat")

  open(unit=2, file="output.dat")

  do i=1, 3

       read(1, 7) (A(i,j), j=1,4)

       7 format(4(I2, 1x))

 end do

 do i=1, 4

      read(1, 8) (B(i, j), j=1,2)

      8 format(2(I2, 1x))

 end do

 do i=1,3           !row of AB

    do j=1,2           !column of AB

       AB(i, j)=0.0

           do k=1, 4         !column of A or Row of B

      AB(i, j)=AB(i,j) + A(i,k)*B(k, j)            !Product of A and B

            end do

         end do

    end do

 write(2, 9) "i) AB matrix is ="

  9 format(A18)

 do i=1,3

    write(2,10) (AB(i,j), j=1, 2)

    10 format(2(i4, 1x))

 end do

 do i=1,3

   do j=1,4

       C(i,j)= A(i,j)*A(i,j)

          end do

       end do

   write(2, 11) "ii) C matrix is ="

   11 format(/,A19)

  do i=1,3

       write(2,12) (C(i,j), j=1, 4)

       12 format(4(i4, 1x))

 end do

 end program