[ previous ] [ Contents ] [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ] [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 10 ] [ 11 ] [ 12 ] [ 13 ] [ next ]
Fortran 90 Lessons for Computational Chemistry
Los objetivos de esta clase son los siguientes:
Explicar como se deben gestionar los errores en la invocación de funciones y subrutinas.
Explicar como se pasa el nombre de una función o subrutina como argumento declarando las funciones o subrutinas implicadas con el atributo EXTERNAL.
Explicar como se pasa el nombre de una función o subrutina como argumento declarando las funciones o subrutinas en un módulo.
Se debe evitar que un programa termine sin que una subprograma (función o subrutina) devuelva el control al programa que lo ha invocado. Por ello se debe no usar la orden STOP en el interior de subprogramas. La mejor forma de gestionar errores en una subrutina, sobre todo aquellos debidos a una incorrecta definición de los argumentos de entrada de la subrutina, es mediante el uso de varibles flag (bandera) que marquen que ha tenido lugar un error. En el siguiente ejemplo se calcula la raíz cuadrada de la diferencia entre dos números, y la variable sta_flag es cero si la subrutina se ejecuta sin problemas o uno si se trata de calcular la raíz cuadrada de un número negativo.
SUBROUTINE calc(a_1, a_2, result, sta_flag)
IMPLICIT NONE
REAL, INTENT(IN) :: a_1, a_2
REAL, INTENT(OUT) :: result
INTEGER, INTENT(OUT) :: sta_flag
!
REAL :: temp
!
temp = a_1 - a_2
IF (temp >= 0) THEN
result = SQRT(temp)
sta_flag = 0
ELSE
result = 0.0
sta_flag = 1
ENDIF
END SUBROUTINE calc
Una vez ejecutada la subrutina se debe comprobar el valor de la variable sta_flag para informar si ha existido algún problema.
Al invocar una subrutina los argumentos pasan como una serie de punteros a ciertas posiciones de memoria. Eso permite que como argumento figure una función o subrutina.
En el caso de funciones, cuando se incluye el nombre de una función en la lista de argumentos se transforma en un puntero a dicha función. Para ello las funciones han de ser declaradas con el atributo EXTERNAL. Si, por ejemplo, desde un programa llamamos a una subrutina llamada evaluate_func para evaluar las funciones fun_1 y fun_2 podemos hacer algo como
PROGRAM test
IMPLICIT NONE
REAL :: fun_1, fun_2
EXTERNAL fun_1, fun_2
REAL :: x, y, output
......
CALL evaluate_func(fun_1, x, y, output)
CALL evaluate_func(fun_2, x, y, output)
......
END PROGRAM test
SUBROUTINE evaluate_func(fun, a, b, out)
REAL, EXTERNAL :: fun
REAL, INTENT(IN) :: a, b
REAL, INTENT(OUT) :: out
!
out = fun(a,b)
END SUBROUTINE evaluate_func
En el Programa ejemplo_11_1.f90, Section 11.3.1 se muestra un ejemplo en el que se evalua, dependiendo de la elección del usuario, el producto o el cociente entre dos números. Dependiendo de la elección se utiliza la subrutina Eval_Func, que acepta como uno de sus argumentos el nombre de la función que se va a evaluar, prod_func o quot_func. Debe indicarse el tipo de variable asociado a la función, pero no se puede especificar el atributo INTENT.
También pueden usarse nombres de subrutinas como argumentos. Para pasar el nombre de una subrutina como argumento dicha subrutina debe ser declarada con el atributo EXTERNAL. En el siguiente ejemplo una subrutina llamada launch_sub acepta como argumentos de entrada las variables x_1 y x_2 y el nombre de una subrutina a la que invoca con las variables anteriores como argumentos y tiene como argumento de salida la variable result.
SUBROUTINE launch_sub(x_1, x_2, sub_name, result)
IMPLICIT NONE
REAL, INTENT(IN) :: x_1, x_2
EXTERNAL sub_name
REAL, INTENT(OUT) :: result
......
CALL sub_name(x_1, x_2, result)
......
END SUBROUTINE launch_sub
Como puede verse en este ejemplo, el argumento que indica la subrutina (sub_name) no lleva asociado el atributo INTENT. En el Programa ejemplo_11_2.f90, Section 11.3.2 se muestra un ejemplo similar al anterior, en el que se evalua dependiendo de la elección del usuario el producto o el cociente entre dos números. Dependiendo de la elección se utiliza la subrutina Eval_Sub, que acepta como uno de sus argumentos el nombre de la subrutina que se va a evaluar, prod_sub o quot_sub.
En el Programa ejemplo_11_3.f90, Section 11.3.3 se muestra un ejemplo algo más complejo en el que se evalua, dependiendo de la elección del usuario, una función entre tres posibles para un intervalo de la variable independiente. En este caso las funciones se declaran como EXTERNAL y se utiliza una subrutina interna para la definición del vector de la variable independiente, de acuerdo con la dimensión que proporciona el usuario, y la subrutina Eval_Func que acepta como uno de sus argumentos el nombre de la función que se evalue mostrando los resultados en pantalla.
Es posible también comunicar a un subprograma el nombre de una función o una
subrutina mediante el uso de módulos. En el Programa
ejemplo_11_4.f90, Section 11.3.4 se muestra un programa similar al Programa ejemplo_11_3.f90, Section 11.3.3 utilizando
módulos. El módulo Functions_11_4 debe compilarse en un fichero
separado al del programa principal. Si, por ejemplo el módulo se llama
ejemplo_11_4_mod.f90 y el programa principal
ejemplo_11_4.f90 el procedimiento sería el siguiente
$ gfortran -c ejemplo_11_4_mod.f90
$ gfortran ejemplo_11_4.f90 ejemplo_11_4_mod.o
Como ocurría en el caso anterior, el o los argumentos que indican funciones o subrutinas no llevan el atributo INTENT.
PROGRAM func_option
!
! Select between funs to compute the product of the quotient of two quantities
!
IMPLICIT NONE
!
!
REAL :: X_1, X_2
INTEGER :: I_fun
INTEGER :: I_exit
!
REAL, EXTERNAL :: prod_fun, quot_fun
!
I_exit = 1
!
DO WHILE (I_exit /= 0)
!
PRINT*, "X_1, X_2?"
READ(UNIT = *, FMT = *) X_1, X_2
!
PRINT*, "function 1 = X_1 * X_2, 2 = X_1/X_2 ? (0 = exit)"
READ(UNIT = *, FMT = *) I_fun
!
SELECT CASE (I_fun)
!
CASE (0)
I_exit = 1
CASE (1)
CALL Eval_func(prod_fun, X_1, X_2)
CASE (2)
CALL Eval_func(quot_fun, X_1, X_2)
CASE DEFAULT
PRINT*, "Valid options : 0, 1, 2"
!
END SELECT
!
PRINT*, "Continue? (0 = exit)"
READ(UNIT=*, FMT = *) I_exit
!
!
ENDDO
!
END PROGRAM func_option
!
SUBROUTINE Eval_Func(fun, X_1, X_2)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: X_1, X_2
REAL, EXTERNAL :: fun
!
PRINT 10, fun(X_1, X_2)
!
10 FORMAT(1X, ES16.8)
!
END SUBROUTINE Eval_Func
!
!
FUNCTION prod_fun(x1, x2)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x1, x2
!
REAL prod_fun
!
prod_fun = x1*x2
!
END FUNCTION prod_fun
!
FUNCTION quot_fun(x1, x2)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x1, x2
!
REAL quot_fun
!
quot_fun = x1/x2
!
END FUNCTION quot_fun
PROGRAM sub_option
!
! Select between subs to compute the product or the quotient of two quantities
!
IMPLICIT NONE
!
!
REAL :: X_1, X_2
INTEGER :: I_sub
INTEGER :: I_exit
!
EXTERNAL :: prod_sub, quot_sub
!
I_exit = 1
!
DO WHILE (I_exit /= 0)
!
PRINT*, "X_1, X_2?"
READ(UNIT = *, FMT = *) X_1, X_2
!
PRINT*, "function 1 = X_1 * X_2, 2 = X_1/X_2 ? (0 = exit)"
READ(UNIT = *, FMT = *) I_sub
!
SELECT CASE (I_sub)
!
CASE (0)
I_exit = 0
CASE (1)
CALL Eval_Sub(prod_sub, X_1, X_2)
CASE (2)
CALL Eval_Sub(quot_sub, X_1, X_2)
CASE DEFAULT
PRINT*, "Valid options : 0, 1, 2"
!
END SELECT
!
PRINT*, "Continue? (0 = exit)"
READ(UNIT=*, FMT = *) I_exit
!
ENDDO
!
END PROGRAM sub_option
!
SUBROUTINE Eval_Sub(sub, X_1, X_2)
!
IMPLICIT NONE
!
EXTERNAL :: sub
REAL, INTENT(IN) :: X_1, X_2
!
REAL :: res_sub
!
CALL sub(X_1, X_2, res_sub)
PRINT 10, res_sub
!
10 FORMAT(1X, ES16.8)
!
END SUBROUTINE Eval_Sub
!
!
SUBROUTINE prod_sub(x1, x2, y)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x1, x2
REAL, INTENT(OUT) :: y
!
y = x1*x2
!
END SUBROUTINE prod_sub
!
!
SUBROUTINE quot_sub(x1, x2, y)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x1, x2
REAL, INTENT(OUT) :: y
!
y = x1/x2
!
END SUBROUTINE quot_sub
PROGRAM call_func
!
! Select which curve is computed and saved in a given interval e.g. (-2 Pi, 2 Pi)
!
! 1 ---> 10 x^2 cos(2x) exp(-x)
! 2 ---> 10 (-x^2 + x^4)exp(-x^2)
! 3 ---> 10 (-x^2 + cos(x)*x^4)exp(-x^2)
!
IMPLICIT NONE
!
!
REAL, DIMENSION(:), ALLOCATABLE :: X_grid
!
REAL, PARAMETER :: pi = ACOS(-1.0)
!
REAL :: X_min, X_max, Delta_X
INTEGER :: X_dim, I_fun
INTEGER :: I_exit, Ierr
!
REAL, EXTERNAL :: fun1, fun2, fun3
!
X_min = -2*pi
X_max = 2*pi
!
I_exit = 0
!
DO WHILE (I_exit /= 1)
!
PRINT*, "number of points? (0 = exit)"
READ(UNIT=*, FMT = *) X_dim
!
IF (X_dim == 0) THEN
!
I_exit = 1
!
ELSE
ALLOCATE(X_grid(1:X_dim), STAT = Ierr)
IF (Ierr /= 0) THEN
STOP 'X_grid allocation failed'
ENDIF
!
CALL make_Grid(X_min, X_max, X_dim)
!
PRINT*, "function 1, 2, or 3? (0 = exit)"
READ(UNIT = *, FMT = *) I_fun
!
SELECT CASE (I_fun)
!
CASE (0)
I_exit = 1
CASE (1)
CALL Eval_func(fun1, X_dim, X_grid)
CASE (2)
CALL Eval_func(fun2, X_dim, X_grid)
CASE (3)
CALL Eval_func(fun3, X_dim, X_grid)
CASE DEFAULT
PRINT*, "Valid options : 0, 1, 2, 3"
!
END SELECT
!
DEALLOCATE(X_grid, STAT = Ierr)
IF (Ierr /= 0) THEN
STOP 'X_grid deallocation failed'
ENDIF
!
ENDIF
!
ENDDO
!
CONTAINS
!
SUBROUTINE make_Grid(X_min, X_max, X_dim)
!
REAL, INTENT(IN) :: X_min, X_max
INTEGER, INTENT(IN) :: X_dim
!
INTEGER :: Index
REAL :: Delta_X
!
!
Delta_X = (X_max - X_min)/REAL(X_dim - 1)
!
X_grid = (/ (Index, Index = 0 , X_dim - 1 ) /)
X_grid = X_min + Delta_X*X_grid
!
END SUBROUTINE make_Grid
!
END PROGRAM call_func
!
SUBROUTINE Eval_Func(fun, dim, X_grid)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: dim
REAL, DIMENSION(dim), INTENT(IN) :: X_grid
REAL, EXTERNAL :: fun
!
INTEGER :: Index
!
DO Index = 1, dim
PRINT 10, X_grid(Index), fun(X_grid(Index))
ENDDO
!
10 FORMAT(1X, ES16.8,2X, ES16.8)
!
END SUBROUTINE Eval_Func
!
!
FUNCTION fun1(x)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x
!
REAL fun1
!
fun1 = 10.0*x**2*cos(2.0*x)*exp(-x)
!
END FUNCTION fun1
!
FUNCTION fun2(x)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x
!
REAL fun2
!
fun2 = 10.0*(-x**2 + x**4)*exp(-x**2)
!
END FUNCTION fun2
!
FUNCTION fun3(x)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x
!
REAL fun3
!
fun3 = 10.0*(-x**2 + cos(x)*x**4)*exp(-x**2)
!
END FUNCTION fun3
PROGRAM call_func
!
! Select which curve is computed and saved in a given interval e.g. (-2 Pi, 2 Pi)
!
! 1 ---> 10 x^2 cos(2x) exp(-x)
! 2 ---> 10 (-x^2 + x^4)exp(-x^2)
! 3 ---> 10 (-x^2 + cos(x)*x^4)exp(-x^2)
!
USE Functions_11_4
!
IMPLICIT NONE
!
!
REAL, DIMENSION(:), ALLOCATABLE :: X_grid
!
REAL, PARAMETER :: pi = ACOS(-1.0)
!
REAL :: X_min, X_max, Delta_X
INTEGER :: X_dim, I_fun
INTEGER :: I_exit, Ierr
!
X_min = -2*pi
X_max = 2*pi
!
I_exit = 0
!
DO WHILE (I_exit /= 1)
!
PRINT*, "number of points? (0 = exit)"
READ(UNIT=*, FMT = *) X_dim
!
IF (X_dim == 0) THEN
!
I_exit = 1
!
ELSE
ALLOCATE(X_grid(1:X_dim), STAT = Ierr)
IF (Ierr /= 0) THEN
STOP 'X_grid allocation failed'
ENDIF
!
CALL make_Grid(X_min, X_max, X_dim)
!
PRINT*, "function 1, 2, or 3? (0 = exit)"
READ(UNIT = *, FMT = *) I_fun
!
SELECT CASE (I_fun)
!
CASE (0)
I_exit = 1
CASE (1)
CALL Eval_func(fun1, X_dim, X_grid)
CASE (2)
CALL Eval_func(fun2, X_dim, X_grid)
CASE (3)
CALL Eval_func(fun3, X_dim, X_grid)
CASE DEFAULT
PRINT*, "Valid options : 0, 1, 2, 3"
!
END SELECT
!
DEALLOCATE(X_grid, STAT = Ierr)
IF (Ierr /= 0) THEN
STOP 'X_grid deallocation failed'
ENDIF
!
ENDIF
!
ENDDO
!
CONTAINS
!
SUBROUTINE make_Grid(X_min, X_max, X_dim)
!
REAL, INTENT(IN) :: X_min, X_max
INTEGER, INTENT(IN) :: X_dim
!
INTEGER :: Index
REAL :: Delta_X
!
!
Delta_X = (X_max - X_min)/REAL(X_dim - 1)
!
X_grid = (/ (Index, Index = 0 , X_dim - 1 ) /)
X_grid = X_min + Delta_X*X_grid
!
END SUBROUTINE make_Grid
!
END PROGRAM call_func
!
SUBROUTINE Eval_Func(fun, dim, X_grid)
!
USE Functions_11_4
!
IMPLICIT NONE
!
REAL :: fun
INTEGER, INTENT(IN) :: dim
REAL, DIMENSION(dim), INTENT(IN) :: X_grid
!
INTEGER :: Index
!
DO Index = 1, dim
PRINT 10, X_grid(Index), fun(X_grid(Index))
ENDDO
!
10 FORMAT(1X, ES16.8,2X, ES16.8)
!
END SUBROUTINE Eval_Func
!
MODULE Functions_11_4
IMPLICIT NONE
!
CONTAINS
!
!
FUNCTION fun1(x)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x
!
REAL fun1
!
fun1 = 10.0*x**2*cos(2.0*x)*exp(-x)
!
END FUNCTION fun1
!
FUNCTION fun2(x)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x
!
REAL fun2
!
fun2 = 10.0*(-x**2 + x**4)*exp(-x**2)
!
END FUNCTION fun2
!
FUNCTION fun3(x)
!
IMPLICIT NONE
!
REAL, INTENT(IN) :: x
!
REAL fun3
!
fun3 = 10.0*(-x**2 + cos(x)*x**4)*exp(-x**2)
!
END FUNCTION fun3
END MODULE Functions_11_4
[ previous ] [ Contents ] [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ] [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 10 ] [ 11 ] [ 12 ] [ 13 ] [ next ]
Fortran 90 Lessons for Computational Chemistry
mailto:francisco.perez@dfaie.uhu.es