Programation Book (Fortran)

Document containing FORTRAN programs aimed at solving the roots for an equation in one variable.
f90-raices.pdf

.

Bisection Method

SUBROUTINE biseccion(f,a,b,n,tol,raiz,clave)
! ---------------------------------------------------
! METODO DE BISECCION para encontrar una solución
! de f(x)=0 dada la función continua f en el intervalo
! [a,b] donde f(a) y f(b) tienen signos opuestos.
! ---------------------------------------------------
! Bloque de declaración de argumentos
! ---------------------------------------------------
USE precision, WP => DP
IMPLICIT NONE
INTERFACE
FUNCTION f(x) ! Función que define la ecuación
USE precision, WP => DP
IMPLICIT NONE
REAL(WP) :: f
REAL(WP), INTENT(IN) :: x
END FUNCTION f
END INTERFACE
REAL(WP), INTENT(IN) :: a ! Extremo izquierdo del intervalo inicial
REAL(WP), INTENT(IN) :: b ! Extremo derecho del intervalo inicial
INTEGER, INTENT(INOUT) :: n ! Número máximo de iteraciones/ iteraciones realizadas
REAL(WP), INTENT(IN) :: tol ! Tolerancia para el error absoluto
REAL(WP), INTENT(OUT) :: raiz ! Aproximación a la raiz
INTEGER, INTENT(OUT) :: clave ! Clave de éxito:
! 0 : éxito
! >0 : iteraciones excedidas
! <0 : no se puede proceder (f de igual signo en a y b)
! ---------------------------------------------------
! Bloque de declaración de variables locales
! ---------------------------------------------------
INTEGER :: i
REAL(WP) :: xl, xr, signfxl, error
! ---------------------------------------------------
! Bloque de procesamiento
! ---------------------------------------------------
xl = a
xr = b
signfxl = SIGN(1.0_WP,f(xl))
IF (signfxl*f(xr) > 0.0_WP) THEN
clave = -1
RETURN
ENDIF
DO i=1,n
error = (xr-xl)*0.5_WP
raiz = xl + error
IF (error < tol) THEN
clave = 0
n = i
RETURN
ENDIF
IF (signfxl*f(raiz) > 0.0_WP) THEN
xl = raiz
ELSE
3
xr = raiz
ENDIF
ENDDO
clave = 1
RETURN
END SUBROUTINE biseccion

Newton - Rhapson Method 

SUBROUTINE newton(f,df,x0,n,tol,raiz,clave)
! ---------------------------------------------------
! Metodo DE NEWTON-RAPHSON para encontrar una
! solución de f(x)=0 dada la función derivable
! f y una aproximación inicial x0.
! ---------------------------------------------------
! Bloque de declaración de argumentos
! ---------------------------------------------------
USE precision, WP => DP
IMPLICIT NONE
INTERFACE
FUNCTION f(x) ! Función que define la ecuación
USE precision, WP => DP
IMPLICIT NONE
REAL(WP) :: f
REAL(WP), INTENT(IN) :: x
END FUNCTION f
FUNCTION df(x) ! Derivada de la función que define la ecuación
USE precision, WP => DP
IMPLICIT NONE
REAL(WP) :: df
REAL(WP), INTENT(IN) :: x
END FUNCTION df
END INTERFACE
REAL(WP), INTENT(IN) :: x0 ! Aproximación inicial a la raíz
INTEGER, INTENT(INOUT) :: n ! Número máximo de iteraciones/ iteraciones realizadas
REAL(WP), INTENT(IN) :: tol ! Tolerancia para el error relativo
REAL(WP), INTENT(OUT) :: raiz ! Aproximación a la raiz
INTEGER, INTENT(OUT) :: clave ! Clave de éxito:
! 0 : éxito
! >0 : iteraciones excedidas
! ---------------------------------------------------
! Declaración de variables locales
! ---------------------------------------------------
INTEGER :: i
REAL(WP) :: xx0
4
! ---------------------------------------------------
! Bloque de procesamiento
! ---------------------------------------------------
xx0 = x0
DO i=1,n
raiz = xx0 - f(xx0)/df(xx0)
IF (ABS((raiz-xx0)/raiz) < tol) THEN
clave = 0
n = i
RETURN
ENDIF
xx0 = raiz
END DO
clave = 1
RETURN
END SUBROUTINE newton 

Birge - Vieta Method

Solve Algebraic Ecuations

SUBROUTINE birge_vieta(a,m,x0,n,tol,raiz,clave)
! ---------------------------------------------------
! METODO DE BIRGE-VIETA para resolver ECUACIONES
! ALGEBRAICAS: P (x) = 0 donde P es un polinomio de
5
! grado m de coeficientes reales.
! El método se basa en el método de Newton-Raphson
! implementando el esquema de Horner para la evalua-
! ción del polinomio y su derivada.
! ---------------------------------------------------
! Bloque de declaración de argumentos
! ---------------------------------------------------
USE precision, WP => DP
IMPLICIT NONE
INTEGER, INTENT(IN) :: m ! Grado del polinomio
REAL(WP), DIMENSION(0:m), INTENT(IN) :: a ! Vector de m+1 elementos conteniendo
! los coeficientes del polinomio
REAL(WP), INTENT(IN) :: x0 ! Aproximación inicial a la raíz
REAL(WP), INTENT(IN) :: tol ! Tolerancia para el error absoluto
INTEGER, INTENT(INOUT) :: n ! Max. iteraciones/iteraciones realizadas
REAL(WP), INTENT(OUT) :: raiz ! Aproximación a la raiz
INTEGER, INTENT(OUT) :: clave ! Clave de éxito:
! 0 : éxito
! >0 : iteraciones excedidas
! ---------------------------------------------------
! Bloque de declaración de variables locales
! ---------------------------------------------------
INTEGER :: i, j
REAL(WP):: xx0,b,c
! ---------------------------------------------------
! Bloque de procedimiento
! ---------------------------------------------------
xx0 = x0
DO i=1,n
! -------------------------
! Esquema de Horner
! -------------------------
b = a(m)
c = a(m)
DO j=m-1,1,-1
b = b*xx0+a(j)
c = c*xx0+b
ENDDO
b = b*xx0+a(0)
! -------------------------
! Método de Newton
! -------------------------
raiz = xx0 - b/c
IF (ABS((raiz-xx0)/raiz) < tol) THEN
clave = 0
n = i
RETURN
END IF
xx0 = raiz
END DO
clave = 1
RETURN
END SUBROUTINE birge_vieta

Secante Method

SUBROUTINE secante(f,x0,x1,n,tol,raiz,clave)
! ---------------------------------------------------
! ALGORITMO DE LA SECANTE para encontrar una solución
! de f(x)=0, siendo f una función continua, dada las
! aproximaciones iniciales x0 y x1.
! ---------------------------------------------------
! Bloque de declaración de argumentos
! ---------------------------------------------------
USE precision, WP => DP
IMPLICIT NONE
INTERFACE
FUNCTION f(x) ! Función que define la ecuación
USE precision, WP => DP
IMPLICIT NONE
REAL(WP) :: f
REAL(WP), INTENT(IN) :: x
END FUNCTION f
END INTERFACE
REAL(WP), INTENT(IN) :: x0,x1 ! Aproximaciones iniciales a la raíz
INTEGER, INTENT(INOUT) :: n ! Número máximo de iteraciones/ iteraciones realizadas
REAL(WP), INTENT(IN) :: tol ! Tolerancia para el error relativo
REAL(WP), INTENT(OUT) :: raiz ! Aproximación a la raiz
INTEGER, INTENT(OUT) :: clave ! Clave de éxito:
! 0 : éxito
! >0 : iteraciones excedidas
! ---------------------------------------------------
! Bloque de declaración de variables locales
! ---------------------------------------------------
INTEGER :: i
REAL(WP):: xx0, xx1, fx0, fx1
! ---------------------------------------------------
! Bloque de procesamiento
! ---------------------------------------------------
xx0 = x0
xx1 = x1
fx0 = f(x0)
fx1 = f(x1)
DO i= 2,n
raiz = xx1 - fx1*((xx1-xx0)/(fx1-fx0))
IF (ABS((raiz-xx1)/raiz) < tol) THEN
clave = 0
n = i
RETURN
ENDIF
7
xx0 = xx1
fx0 = fx1
xx1 = raiz
fx1 = f(raiz)
END DO
clave = 1
RETURN
END SUBROUTINE secante

Fixed Point Method

SUBROUTINE punto_fijo(f,x0,n,tol,raiz,clave)
! ---------------------------------------------------
! ALGORITMO DE PUNTO FIJO o DE APROXIMACIONES SUCESIVAS
! para encontrar una solución de x=f(x) dada una
! aproximación inicial x0.
! ---------------------------------------------------
! Bloque de declaración de argumentos
! ---------------------------------------------------
USE precision, WP => DP
IMPLICIT NONE
INTERFACE
FUNCTION f(x) ! Función que define la ecuación
USE precision, WP => DP
IMPLICIT NONE
REAL(WP) :: f
REAL(WP), INTENT(IN) :: x
END FUNCTION f
END INTERFACE
REAL(WP), INTENT(IN) :: x0 ! Aproximación inicial a la raíz
INTEGER, INTENT(INOUT) :: n ! Número máximo de iteraciones/ iteraciones realizadas
REAL(WP), INTENT(IN) :: tol ! Tolerancia para el error relativo
REAL(WP), INTENT(OUT) :: raiz ! Aproximación a la raiz
INTEGER, INTENT(OUT) :: clave ! Clave de éxito:
! 0 : éxito
! >0 : iteraciones excedidas
! ---------------------------------------------------
! Bloque de declaración de variables locales
! ---------------------------------------------------
INTEGER :: i
REAL(WP) :: xx0
! ---------------------------------------------------
! Bloque de procesamiento
! ---------------------------------------------------
8
xx0 = x0
DO i=1,n
raiz = f(xx0)
IF (ABS((raiz-xx0)/raiz) < TOL) THEN
clave = 0
n = i
RETURN
ENDIF
xx0 = raiz
END DO
clave = 1
RETURN
END SUBROUTINE punto_fijo