Newton - Raphson Method

Find by Newton-Raphson method  the real root of 
   3x - Cosx - 1 = 0 in the interval [1,2]

Program Fixed_method
    Implicit none
    Real :: l , m , c , g
    Integer :: i
    Write ( * , * ) ' Input interval a and b ' 
    Read ( * , * ) l , m
    Write ( * , 67 ) ' Number' , 'value of x' , 'value of f(x)' , 'Absolute error'
    67 Format ( / , / , A7 , 7x , A11 , 5x , A14 , 2x , A15 )
    c = l
    do i = 1 , 100
        g = ( c + 10.0 ) ** ( 1.0 / 4.0 )
        Write ( * , 66 ) i , c , g , abs (c - g )
        66 Format (2x , i3 , 11x , f8.6 , 8x , f8.6 , 8x , f8.6 )
        If( abs ( c - g ) .le. 0.0000001 ) Exit
        c = g
        End do
        Write( * , 21 ) ' The approximate root of the function is  :  ' , c
        21 Format (  /  ,  / , A42 , F12.9 )
        End program


        Subroutine func ( g , x )
            Real,intent(in)::x
            Real,intent(out)::g
            g = x**4 - x - 10
            End subroutine


            Subroutine interval ( l , m )
                Real , intent(in) : : l , m
                Real :: g , h , x
                call func ( g , l )
                call func ( h , m )
                k = g * h
                If ( k .lt. 0 )then
                    x = l
                    Write ( * , * ) "There is a root in this interval . "
                    Else if ( k .gt. 0 ) then
                        x = 0
                        Write ( * , * ) 'There is no root in this interval . '
                        Elseif  ( g == 0 ) then
                            Write( * , * ) g
                            Else
                                Write( * , * ) h
                                Endif
                                End Subroutine

Input : 

Output :

Bisection Method

Consider finding the root of  f(x) = Cos[x] – x . Let ε_step = 0.01 ,  ε_abs = 0.001 and start with the interval [1.0 ,  0.5] .

Program Bisection_method

    Implicit none

    Real :: a , b , f , c , error

    

Write( * , * ) " Enter numbers between which the root is to be found : "   !(Can be change)

      10 read ( * , * ) a , b

 Write ( * , 61 ) " Input error value : "    !(Can be change)

       61 Format ( / , / , a18 )

        Read ( * , * ) error

     

  15 If ( f ( a ) * f ( b ) . lt . 0 )then

            c = ( a+b ) / 2.0

         else

  Write ( * , 62 ) " There is no zeros in this interval. Try with  another value of a & b "

       62 Format  ( / , / , a65 )

           go to 10

        Endif

        if ( f (a) * f (c) . lt . 0) then

            b = c

           else

          a = c

        Endif

       if ( abs (b-a) . gt . error ) goto 15

       write ( * , 63 ) " The approximate root of the function is : " , c

           63 Format ( / , / , a42 , f12.9 )

        end

    function f (x)

            implicit none

            real : : f , x

            f = cos (x) - x   !(Can be change)

    end function

Input ::

Output : :

Transpose matrix

Save   the   matrix  (A)  in  a  file  as  it  is 

 2        3          5
 7       11         0
-1      -13       -17

Print  A  and  transpose  of  A  in matrix  form .

Program coding

Program transpose_matrix
Integer , Dimension ( 3 , 3 ) : : a , b

Write ( * , 11 )  ' Input matrix  A '
11 format  ( / , A16 )

Read ( * , * ) ( ( a ( i , j ) , j = 1 , 3 ) , i = 1 , 3 )

Do i = 1 , 3
    Do j = 1,  3
        b ( i , j ) = a ( j , i )
    End do
End do

Write ( * , 12 ) ' A = '
12 Format ( / , A5 )

Do i = 1 , 3
Write ( * , * ) ( a ( i , j ) , j = 1 , 3 )
End do

Write ( * , 13 ) ' Then transpose of A  = '
13 Format  ( / , A20 )

Write ( * , 14 ) ( (  b ( i , j ) , j = 1 , 3 ) , i = 1 , 3 )
14 Format ( 3I4 , / , 3I4 ,  / , 3I4)


Stop
End

Input  :

Output :

GDC ( Greatest Common Divisor )

Write  a  program  to  find  the GCD ( Greatest  Common  Divisor ) of  many  positive  integers .


Programming  Coding .... 

Program GCD_Program
    Implicit none
    Integer :: n , a(100) , i , c , gcd
    Write ( * , 2 ) 'How  many  numbers  input  for  GCD ?'
    2 Format ( A40 )
    Read ( * , *)  n
    Write( * , 3 ) 'Input numbers :'
    3 Format ( / , A20 )
    Read ( *, * ) ( a(i) , i = 1 , n )
    Do i = 1 , ( n - 1 )
     7   c = mod (a(i) , a(i+1))
        If  ( c == 0 ) then
            gcd = a( i + 1)
            Else
                a(i) = a ( i +1 )
                a( i+1 ) = c
                Goto 7
                End if
                End do
                Write ( * , 12 ) 'GCD = ' , gcd
                12 Format ( / , A7 , I7 )

                End Program

 Input ::

Output ::                                                           

                                    

Decimal Number to Binary Equivalent

Write  a  Program  to  convert  a  Decimal  number  to  its  Binary  equivalent .

Program Coding    : :

Program  Binary_Number

 Implicit  none

 Integer :: i_part , rem , i_base

 Real ( kind=8 ) :: Bina_num ,  Deci_num ,  r_part , r_base , ir_part

 21 Print *, "Decimal Number :"

 Read (*,*) Deci_num

 Bina_num = 0.0 !For Integer Part of Deci_num equivalent Binary

 i_base = 1

 i_part = INT(Deci_num)

 Do while (i_part>0)

     rem = Mod(i_part, 2)

     Bina_num = Bina_num + rem*i_base

   i_base = i_base*10

   i_part = Int(i_part/2)

 end do           !For Real Part of Deci_num equivalent Binary

r_base = 0.1

 r_part = Deci_num -INT(Deci_num) !Real part of Decimal number

Do while(r_part > 0)

 r_part = r_part * 2

 ir_part = Int(r_part)     !Integer part of Real_part*2

 Bina_num = Bina_num  +  ir_part * r_base

 r_base = r_base / 10.0

 r_part = r_part - ir_part      !Again Real part is only decimal value

 End do

 Write(*,121) "Binary Number :"  ,  Bina_num

 121 format(2x, A15, f20.6 , / , / )

 Goto 21

 End program

Input  : :

Output  ::

Read Underlined Digits and Print

Write  a  program  that  reads  the  underlined  digits  as  individual  integers  . Then  add 1  to  each  integer   and  print  them  .
 
                     123456
           297645
           356987


Program Coding :

Program Individuals_Integer
 Implicit none
 integer ::  N(3) , i
  open(unit=1 ,  File = "Input.dat" )
  open(unit=2 ,  File = "Output.dat" )
 Read(1,21) ( N(i), i = 1, 3)
 21 format ( / , / , 3 (1x , I1))
       Do i = 1 , 3
           N(i) = N(i) + 1             !Adding 1 to each integer
      end do
      Do i = 1 , 3
          write (2,12)  N(i)
          12 format (I2)
          end do

 end program


Input:

Output:

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