Dismiss Notice
Join Physics Forums Today!
The friendliest, high quality science and math community on the planet! Everyone who loves science is here!

Need outputs for fortran 77 programs

  1. Feb 9, 2009 #1
    hi

    i need fortran program outputs very urgently.
    i have the programs , but i'll not able to run the compiler.

    can someone please post the complete outputs for these programs..

    THANK YOU

    Code (Text):
    Program 15:
    Program to interpolate a value of dependent variable ‘y’ for a given value of independent ‘x’ using Lagrangian Interpolation Method

        real y [allocatable](:), x [allocatable](:)
        real product, sum, xx
        integer n, i, j, error
        write (*, ‘(1x,a\)’) ‘Number of tabulated points (n): ’
        read (*,*) n
        allocate (x (n), y(n), stat = error)
        if (error .ne. 0) stop ‘Not enough memory’
        write (*, ‘(/1x, a, i2, a)’) ‘Enter ‘,n,’ pairs of (x,y)’
        read (*,*) ( x(i), y(i), i =, n)
        write (*, ‘(1x, a\)’) ‘Enter value of x for interpolation: ’
        read (*,*) xx
        if ((xx .lt. x(1)) .or. (xx .gt. x(n))) then
            stop ‘Value outside tabulated range’
        endif
        sum = 0.0
        do i = 1, n
            product = 1.0
            do j = 1, n
                if (i .ne. j) then
                    product = product * ((xx-x(j))/(x(i)-x(j)))
                endif
            enddo
            sum = sum + y(i) * product
        enddo
        write (*,50) sum, xx
    50  format (1x, ‘Interpolated value of y =’, f8.3, ‘for x = ’, f6.3)
        deallocate (x, y, stat = error)
        if (error .ne. 0) stop ‘Error in releasing memory’
        end

    Output:








    Program 16:
    Program to find the solution of a linear system of equations by Gauss Jordan method

    real a [allocatable] (: , :)
    integer n, k, i, j, error
    write (*, ‘(1x,a\)’) ‘Enter number of equations (n): ’
    read (*,*) n
    allocate (a(n, n+1), x(n), stat = error)
    if (error .ne. 0) stop ‘Not enough memory’
    write (*,*) ‘Enter coefficients equation wise’
    read (*,*) ((a(i,j), j = 1, n+1), i = 1, n)
    do k = 1, n
        temp = a (k,k)
        if (temp .eq. 0) stop ‘Pivot element becomes zero’
        do j = k, n+1
            a (k,j) = a (k,j)/temp
        enddo
        do i = 1, n
            if (i .ne. k) then
                temp = a (i,k)
                do j = k, n+1
    a (i.j) = a (i,j) - temp * a (k,j)
                enddo
            endif
        enddo
    enddo
    write (*,*) ‘The solution of the system of the equations is: ’
    do i = 1, n
        write (*, ‘(1x, ‘x(‘, i2, ’) = ‘, f7.3)’) i, a(i, n+1)
    enddo  
    deallcoate (a, stat = error)
        if (error .ne. 0) stop ‘Error in releasing memory’
        end


    Output:






    Program 17:
    Program to find the solution of a linear system of equations by Gauss-Elimination method
    Equation:-

    real a [allocatable] (: , :), x [allocatable] (:), temp1, temp2
    real sum
    integer n, k, i, j, error
    write (*, ‘(1x,a\)’) ‘Enter number of equations (n): ’
    read (*,*) n
    allocate (a(n, n+1), x(n), stat = error)
    if (error .ne. 0) stop ‘Not enough memory’
    write (*,*) ‘Enter coefficients equation wise’
    read (*,*) ((a(i,j), j = 1, n+1), i = 1, n)
    do k = 1, n-1
        temp1 = a (k,k)
        if (temp1 .eq. 0) stop ‘Zero division’
        do i = k+1, n
            temp2 = a (i,k)/temp1
            do j = k, n+1
                a (i.j) = a (i,j) - temp2 * a (k,j)
            enddo
        enddo
    enddo
    x(n) = a(n,n+1)/a(n,n)
    do i = n-1, 1, -1
        sum = 0.0
        do j = i+1, n
            sum = sum + a(i,j) * x(j)
        enddo
        x(i) = (a(i,n+1)-sum)/a(i,i)
    enddo
    write(*,*) ‘Solution of the system of the equations is: ’
    do i = 1, n
        write (*,15) i, x(i)
    15      format (1x, ‘x(‘, i2, ’) = ’, f7.3)
        enddo
        deallcoate (a, x, stat = error)
        if (error .ne. 0) stop ‘Error in releasing memory’
        end
    Output:















    Program 18:
    Program to integrate a known function using Trapezoidal Rule

        real a, b, sum, h, integral, f
        integer n, i
        f(x) = x + 5
        write (*, ‘(1x, a\)’) ‘Lower limit of integration (a): ’
        read (*,*) a
        write (*, ‘(1x, a\)’) ‘Upper limit of integration (b): ’
        read (*,*) b
        write (*, ‘(1x, a\)’) ‘Number of intervals (n): ’
        read (*,*) n
        h = (b-a)/n
        sum = (f(a) + f(b))/2
        do i = 1, n-1
            sum = sum + f(a+i*h)
        enddo
        integral = h*sum
        write (*, ‘(//1x, a, f6.3)’) “Value of integral: ”, integral
        end


    OUTPUT:-

















    Program 19:
    Program to integrate a known function using Simspon’s 1/3rd Rule

        real a, b, sum, sum2, sum4, h, integral, f
        integer n, i
        f(x) = x**2+3*x+5
        write (*, ‘(1x, a\)’) ‘Lower limit of integration (a): ’
        read (*,*) a
        write (*, ‘(1x, a\)’) ‘Upper limit of integration (b): ’
        read (*,*) b
        write (*, ‘(1x, a\)’) ‘Number of intervals (n): ’
        read (*,*) n
        h = (b-a)/n
        sum = f(a) + f(b)
        sum2 = 0
        sum4 = 0
        do i = 1, n-2, 2
            sum4 = sum4 +f(a+i*h)
            sum2 = sum2 +f(a+(i+1)*h)
        enddo
        integral  = (h/3)*(sum + 2*sum2 + 4*sum4)
        write (*, ‘(//1x, a, f6.3)’) “Value of integral =”, integral
        end


    OUTPUT:-














    Program 20:
    Program to solve a first order differential equation using Runge-Kutta (Heun’s) second order method

        real s1, s2, x1, xf, y1, x, y, h, f
        integer i
        f(x,y) = x*y
        write (*, ‘(1x, a\)’) ‘Starting solution point (x1,y1): ’
        read (*,*) x1,y1
        write (*, ‘(1x, a\)’) ‘Last point of the interval (xf): ’
        read (*,*) xf
        write (*, ‘(1x, a\)’) ‘Enter step size to be used (h): ’
        read (*,*) h
        x = x1
        y = y1
        i = 1
        write (*, ‘(//1x, a//)’) “Solution points”
        write (*, ‘(1x, 4x, i2, 5x, f6.3, 5x, f6.3)’) i, x, y
        do while (x .lt. xf)
            s1 = f(x,y)
            x= x+h
            s2 = f(x, y+h*s1)
            y = y+h*(s1+s2)/2
            i = i+1
            write (*, ‘(1x, 4x, i2, 5x, f6.3, 5x, f6.3)’) i, x, y
        enddo
        end


    OUTPUT:-





    Program 21:
    Program for Bisection Method to find the root of the equation
    f(x) = x^4-x-10 = 0

    C   program BisectionMethod
    real x1, x2, x3, ep, f
    f(x) = x**4-x-10
    write (*,‘(1x,a\)’) ‘First point of search interval: ’
    read (*,*) x1
    write (*,‘(1x,a\)’) ‘Second point of search interval: ’
    read (*,*) x2
    write (*,’(1x,a\)’) ‘Enter permitted error: ’
    read (*,*) ep
    do while (abs(x1-x2) .gt. ep)
            x3 = (x1+x2)/2
            if (f(x1)*f(x2) .lt. 0) then
                x2 = x3
            else
                x1 = x3
            endif
    enddo
    write (*,‘(1x,a,f8.4)’) ‘Approximate Root: ’,x3
    end

    OUTPUT :-















    Program 22:
    Program for False Position Method to find the root of the equation
    f(x) = x^3-x-4 = 0

    C   program FalsePositionMethod
    real x1, x2, x3, ep, f
    f(x) = x**3-x-4
    write (*,‘(1x,a\)’) ‘First point of search interval: ’
    read (*,*) x1
    write (*,‘(1x,a\)’) ‘Second point of search interval: ’
    read (*,*) x2
    write (*,’(1x,a\)’) ‘Enter permitted error: ’
    read (*,*) ep
    write (*,’(1x,a\)’) ‘Enter lower bound on slope: ’
    read (*,*) delta
    f1 = f(x1)
    f2 = f(x2)
    do while (abs((x1-x2)/x2) .gt. ep)
            if (fabs(f2-f1) .le. delta) then
                print*, “Slope of the function becomes too small”
                stop
            endif
            x3 = (x1*f2-x2*f1) / (f2-f1)
            f3 = f(x3)
            if (f1*f3 .lt. 0) then
                x2 = x3
                f2 = f3
            else
                x1 = x3
                f1 = f3
            endif
    enddo
    write (*,‘(1x,a,f8.4)’) ‘Approximate Root: ’,x3
    end

    OUTPUT :-







    Program 23:
    Program for Newton Raphson Method to find the root of the equation
    f(x) = x^3-x-10 = 0

    program NewtonRaphsonMethod
    real x0, x1, ep, f, df, relerror, f0, df0
    integer I,n
    f(x) = x**3-x-10
    write (*,‘(1x,a\)’) ‘Enter starting approximation: ’
    read (*,*) x0
    write (*,’(1x,a\)’) ‘Enter permitted error: ’
    read (*,*) ep
    write (*,’(1x,a\)’) ‘Enter lower bound on slope: ’
    read (*,*) delta
    write (*,‘(1x,a\)’) ‘Enter maximum iterations permitted: ’
    read (*,*) n
    do i = 1, n
            f0 = f(x0)
            df0 = df(x0)
            if (abs(df0) .le. delta) then
                print*, “Slope of the function becomes too small”
                stop
            endif
            x1 = x0–f0/df0
            relerror = abs((x1-x0)/x1)
            x0=x1
            if (relerror .le. ep) then
                write (*,10) i
    10          format (//1x,‘Solution converges in ’, i2,‘iterations’)
                write (*,‘(1x,a,f8.4)’) ‘Approximate Root: ’,x1
                stop
            endif
    enddo
    write (*,20) n
    20  format (//1x,‘Solution does not converge in ’, i2,‘iterations’)
    end

    OUTPUT :-








    Program 24:
    Program to solve a first order differential equation using Runge-Kutta fourth order method

        real s1, s2, s3, s4, x1, xf, y1, x, y, h, f
        integer i
        f(x,y) = x*y
        write (*, ‘(1x, a\)’) ‘Starting solution point (x1,y1): ’
        read (*,*) x1,y1
        write (*, ‘(1x, a\)’) ‘Last point of the interval (xf): ’
        read (*,*) xf
        write (*, ‘(1x, a\)’) ‘Enter step size to be used (h): ’
        read (*,*) h
        x = x1
        y = y1
        i = 1
        write (*, ‘(//1x, a//)’) “Solution points”
        write (*, ‘(1x, 4x, i2, 5x, f6.3, 5x, f6.3)’) i, x, y
        do while (x .lt. xf)
            s1 = f(x,y)
            s2 = f(x+h/2, y+s1*h/2)
            s3 = f(x+h/2, y+s2*h/2)
            s4 = f(x+h, y+s3*h)
            x= x+h
            y = y+h*(s1+2*s2+2*s3+s4)/6
            i = i+1
            write (*, ‘(1x, 4x, i2, 5x, f6.3, 5x, f6.3)’) i, x, y
        enddo
        end


    OUTPUT:-















    Program 25:
    Program to find the solution of a linear system of equations by Gauss Seidel method

    real a [allocatable] (: , :), x [allocatable] (:)
    real sum, temp, big, absoluteerror, ep
    integer n, k, i, j, error, max
    write (*, ‘(1x,a\)’) ‘Enter number of equations (n): ’
    read (*,*) n
    allocate (a(n, n+1), x(n), stat = error)
    if (error .ne. 0) stop ‘Not enough memory’
    write (*,*) ‘Enter elements row wise’
    read (*,*) ((a(i,j), j = 1, n+1), i = 1, n)
    write (*, ‘(1x,a\)’) ‘Enter permitted error: ’
    read (*,*) ep
    write (*, ‘(1x,a\)’) ‘Enter maximum iterations permitted: ’
    read (*,*) max
    do i = 1, n
        x (i) = 0.0
    enddo
    do k = 1, max
            big = 0.0
            do i = 1, n
                sum = 0.0
                do j = 1, n
                    if (1 .ne. j) sum = sum+a(i,j)*x(j)
                enddo
                temp = (a(i,n+1) – sum)/a(i,i)
                absoluteerror = abs (x(i)-temp)
                if (absoluteerror .gt. big) big = absoluteerror
                x(i) = temp
            enddo
            if (big .le. ep) then
                write (*,100) k
    100         format (//1x, ‘Converges in’, i3, ‘iterations’)
                write (*, ‘(1x, a//)’) ‘The computed solution is: ’
                do i =1, n
                    write (*, ‘(1x, ‘x(‘, i2,’) = ‘, f7.3)’) i, x(i)
                enddo
                stop
            endif
        enddo
        write (*,200) max
    200 format (//1x, ‘Does not converge in ’, i3, ‘iterations’)
        deallcoate (a, x, stat = error)
        if (error .ne. 0) stop ‘Error in releasing memory’
        end



    Output:
     
  2. jcsd
Know someone interested in this topic? Share this thread via Reddit, Google+, Twitter, or Facebook

Can you offer guidance or do you also need help?
Draft saved Draft deleted



Similar Discussions: Need outputs for fortran 77 programs
  1. Fortran 77 output bugs (Replies: 2)

  2. Fortran 77 (Replies: 1)

Loading...