[ anterior ] [ Contenidos ] [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ] [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 10 ] [ 11 ] [ 12 ] [ 13 ] [ siguiente ]
Fortran 90 para la asignatura Química Computacional
Los objetivos de esta clase son los siguientes:
Considerar la diferencia entre funciones y subrutinas y por qué son precisas estas últimas.
Introducir los conceptos e ideas más útiles en la definición de subrutinas.
Argumentos de una subrutina.
Los comandos CALL e INTERFACE.
Alcance (scope) de las variables.
Variables locales y el atributo SAVE
Diferentes formas de transmitir matrices como argumentos a una subrutina.
Definición de matrices automáticas.
El uso de subrutinas favorece una programación estructurada, mediante la definición de subtareas y su realización en las correspondientes subrutinas y evitando con su uso la duplicación innecesaria de código. Además hacen posible el uso de una extensa colección de librerías o bibliotecas de subrutinas programadas y extensamente probadas para una enorme cantidad de posibles aplicaciones.
Para explicar este punto vamos a usar un ejemplo práctico, como es el de la solución de una ecuación de segundo grado. Una posible forma de dividir este programa en subtareas es la siguiente:
Programa principal.
Input de los coeficientes de la ecuación por el usuario.
Solución de la ecuación.
Impresión de las soluciones.
El programa Programa ejemplo_9_1.f90, Sección 9.3.1 se ajusta a este esquema usando dos subrutinas, llamadas Interact y Solve.
La definición de una subrutina tiene la siguiente estructura:
SUBROUTINE nombre_subrutina(lista de argumentos [opcional])
IMPLICIT NONE
Arguments (dummy variables) definition (INTENT)
...
Local variables definition
...
Execution Section
...
[RETURN]
END SUBROUTINE nombre_subrutina
Los argumentos se denominan dummy arguments porque su definición no implica la asignación de memoria alguna. Esta asignación se llevará a cabo de acuerdo con los valores que tomen los argumentos cuando se llame a la subrutina.
Cuando el compilador genera el ejecutable cada subrutina se compila de forma separada lo que permite el uso de variables locales con el mismo nombre en diferentes subrutinas, ya que cada subrutina tiene su particular alcance (scope).
En el programa Programa ejemplo_9_1.f90, Sección 9.3.1 se ve como este esquema se repite para las dos subrutinas empleadas.
Para invocar una subrutina se emplea el comando CALL de acuerdo con el esquema
CALL nombre_subroutina(argumentos [opcional])
Tras la ejecución de la subrutina invocada con la orden CALL, el flujo del programa retorna a la unidad de programa en la que se ha invocado a la subrutina y continúa en la orden siguiente al comando en el que se ha llamado la subrutina con CALL. Desde la subrutina se devuelve la ejecución con el comando RETURN. Si la subrutina llega a su fin también se devuelve el control al programa que la ha invocado, por lo que generalmente no se incluye el comando RETURN justo antes de END SUBROUTINE. Si es posible, las subrutinas deberían tener un solo punto de salida.
La subrutina y el programa principal se comunican a través de los argumentos (también llamados parámetros) de la subrutina. En la definición de la subrutina dichos argumentos son dummies, encerrados entre paréntesis y separados con comas tras el nombre de la subrutina. Dichos argumentos tienen un tipo asociado, pero NO se reserva ningún espacio para ellos en memoria. Por ejemplo, los argumentos E, F y G de la subrutina Solve en el ejemplo Programa ejemplo_9_1.f90, Sección 9.3.1 son del tipo REAL, pero no se reserva para ellos ningún espacio en memoria. Cuando la subrutina es invocada con el comando CALL Solve(P,Q,R,Root1,Root2,IFail) entonces los argumentos E, F y G pasan a ser reemplazados por unos punteros a las variables P, Q y R. Por tanto es muy importante que el tipo de los argumentos y el de las variables por las que se ven reemplazados coincidan, ya que cuando esto no sucede se producen frecuentes errores.
Alguno de los argumentos proporcionan una información de entrada (input) a la subrutina, mientras que otros proporcionan la salida de la subrutina (output). Por último, también es posible que los argumentos sean simultáneamente de entrada y salida.
Aquellos parámetros que solo sean de entrada es conveniente definirlos con el atributo INTENT(IN). Este atributo ya lo vimos en Subprogramas (I): funciones, Capítulo 8 aplicándolo a funciones. Cuando un argumento posee este atributo el valor de entrada del parámetro se mantiene constante y no puede variar en la ejecución de la subrutina.
Si los parámetros solo son de salida es conveniente definirlos con el atributo INTENT(OUT), para que se ignore el valor de entrada del parámetro y debe dársele uno durante la ejecución de la subrutina.
Si el parámetro tiene el atributo INTENT(INOUT), entonces se considera el valor inicial del parámetro así como su posible modificación en la subrutina.
Hay ejemplos de los tres casos arriba citados en la subrutina Solve del ejemplo Programa ejemplo_9_1.f90, Sección 9.3.1. Es muy conveniente etiquetar con el atributo INTENT todos los argumentos.
De acuerdo con lo anterior es de vital importancia que no exista contradicción entre la declaración de variables en el programa que invoca a la subrutina y en la propia subrutina. Para facilitar este acuerdo entre ambas declaraciones existen los llamados interface blocks. En el programa Programa ejemplo_9_2.f90, Sección 9.3.2 podemos ver el programa Programa ejemplo_9_1.f90, Sección 9.3.1 al que se han añadido en el programa principal los interface blocks correspondientes a las subrutinas Interact y Solve.
Al igual que en el caso de las funciones, las variables declaradas en una subrutina que no sean parámetros o argumentos de la misma se consideran locales. Por ejemplo, en la subrutina Interact del Programa ejemplo_9_1.f90, Sección 9.3.1 la variable IO_Status es una variable local de la subrutina.
Generalmente las variables locales se crean al invocarse la subrutina y el valor que adquieren se pierde una vez que la subrutina se ha ejecutado. Sin embargo, usando el atributo SAVE es posible salvar el valor que adquiera la variable de una llamada a la subrutina hasta la siguiente llamada. Por ejemplo
INTEGER, SAVE:: It = 0
El valor que tome en este caso la variable It entre llamadas al subprograma en el que se haya declarado se conserva.
Como en el caso de las funciones, es posible hacer que el programa principal "conozca" las variables de las subrutinas que invoque mediante la orden CONTAINS y haciendo que de hecho las subrutinas formen parte del programa principal. Esta solución resulta difícil de escalar cuando crece la longitud del problema y no es recomendable.
Cuando el argumento de una subrutina no es una variable escalar (del tipo que fuera) sino una matriz (array) es necesario dar una información extra acerca de la matriz. El subprograma al que se pasa la matriz ha de conocer el tamaño de la matriz para no acceder a posiciones de memoria erróneas. Para conseguir esto hay tres posibles formas de especificar las dimensiones de una matriz que se halle en la lista de argumentos de una subrutina:
explicit-shape approach:
En este caso se incluyen como argumentos en la llamada a la subrutina las dimensiones de las matrices implicadas, declarando posteriormente las matrices haciendo uso de dichas dimensiones. Por ejemplo, si en una subrutina llamada test_pass se incluye un vector de entrada llamado space_vec_in y uno de salidaspace_vec_out con la misma dimensión, si hacemos uso del explicit-shape approach la subrutina comenzaría como
SUBROUTINE test_pass(space_vec_in, space_vec_out, dim_vec)
IMPLICIT NONE
INTEGER, INTENT(IN) :: dim_vec
REAL, INTENT(IN), DIMENSION(1:dim_vec) :: space_vec_in
REAL, INTENT(OUT), DIMENSION(1:dim_vec) :: space_vec_out
......
END SUBROUTINE test_pass
assumed-shape approach:
En este caso es necesario incluir el correspondiente bloque INTERFACE en el subprograma que invoca la subrutina. Como veremos en el Subprogramas (III): módulos, Capítulo 10 esto se puede evitar incluyendo la subrutina en un módulo.
En el Programa ejemplo_9_3.f90, Sección 9.3.3 puede verse un programa en el que se calcula la media, la mediana[12], la varianza y la desviación estándar de un conjunto de números generados aleatoriamente. En el programa hemos marcado algunos de los puntos de interés que queremos explicar con detalle.
(1-3) Hemos definido la matriz con dimensión variable, de forma que se dimensione mediante una orden ALLOCATE. En la orden que dimensiona a la matriz se indica que es un vector (DIMENSION(:)) y del mismo modo se hace en el interface block. El uso del interface block es recomendable, y en casos como este, con matrices definidas de este modo, resulta obligatorio. La orden (3), ALLOCATE(X(1:N), STAT = IERR) hace que X pase a ser un vector N-dimensional. Usamos también el campo opcional STAT que nos permita saber si se ha podido dimensionar el arreglo solicitado. Solo si la salida (IERR) es cero la matriz se ha creado sin problemas. El uso de esta opción debe generalizarse.
REAL , ALLOCATABLE , DIMENSION(:) :: X !! (1)
...
INTERFACE
SUBROUTINE STATS(X,N,MEAN,STD_DEV,MEDIAN)
IMPLICIT NONE
...
REAL , INTENT(IN) , DIMENSION(:) :: X !! (1)
...
END SUBROUTINE STATS
END INTERFACE
Es importante tener en cuenta que se puede definir como ALLOCATABLE el argumento con el que se llama a una subrutina, así como a variables internas o locales de la subrutina, pero una variable dummy no puede tener este atributo.
A diferencia de en FORTRAN77, la forma recomendada de transmitir
arreglos de datos entre un programa y una subrutina es como en el ejemplo,
usando assumed shape arguments en los que no se da ninguna información
acerca del tamaño del arreglo. Sí deben coincidir ambas variables en tipo,
rango y clase (KIND).
(4) y (6): En estas órdenes se aprovecha la capacidad de
Fortran90 para trabajar con arreglos de variables, ya sean estos
vectores o matrices. Por ejemplo, el comando X=X*1000 multiplica
todas las componentes del vector X por un escalar y el comando
SUMXI=SUM(X) aprovecha la función SUM para sumar las
componentes del vector. En estilo Fortran 77 estas operaciones
conllevarían un bucle DO, por ejemplo
SUMXI = 0.0
DO I = 1, N
SUMXI = SUMXI + X(I)
ENDDO
(5) En esta parte del programa se libera la memoria reservada para el vector X usando el comando DEALLOCATE. Este paso no es obligatorio en este programa, pero sí cuando la matriz del tipo ALLOCATE se ha definido en una función o subrutina y no tiene el atributo SAVE.
(7) Aquí se aprovecha el comando CONTAINS para hacer que la subrutina de ordenamiento SELECTION, que como puede verse no posee argumentos, conozca las misma variables que la subrutina STATS, en la que está contenida. Por ello, en la subrutina SELECTION solo es preciso definir las variables locales. Esta subrutina se encarga de ordenar la lista de números según un algoritmo que consiste en buscar el número más pequeño de la lista y hacerlo el primer miembro. Se busca a continuación el más pequeño de los restantes que pasa a ser segundo, y así prosigue hasta tener ordenada la lista de números.
La definición de bloques INTERFACE se facilita con el uso de módulos, que describimos en la siguiente unidad.
assumed-size approach
En este caso no se da información a la subrutina acerca de las dimensiones de la matriz, es fácil caer en errores de difícil diagnóstico y se desaconseja su uso.
Arreglos multidimensionales. El Programa
ejemplo_9_5.f90, Sección 9.3.5 es un ejemplo de como pasar como argumentos
arreglos multidimensionales como assumed shape arrays. En él, tras
que el usuario defina dos matrices, A y B, el
programa calcula la matriz C solución del producto AB
y tras ello calcula la matriz traspuesta de A. Se hace uso de las
funciones de Fortran 90 MATMUL y
TRANSPOSE.
En las subrutinas pueden dimensionarse automatic arrays, que pueden depender de los argumentos de la subrutina. Estos arreglos son locales a la subrutina, no pueden tener el argumento SAVE y se crean cada vez que se invoca la subrutina, siendo destruidos al salir de ella. Esto hace que si no hay memoria suficiente para dimensionar el arreglo el programa no funcione. Para evitar esto deben definirse arreglos no automáticos, del tipo ALLOCATABLE.
Al pasar como argumento una variable de tipo CHARACTER dicho argumento se declara con una longitud LEN = * y cuando se llame a la subrutina la longitud de la variable pasa a ser la longitud de la variable en la llamada.
El Programa ejemplo_9_4.f90, Sección 9.3.4 muestra un programa en el que, al darle el nombre de un fichero y el número de datos almacenados en dicho fichero; el programa abre el fichero y lee dos columnas de valores que almacena en los vectores X e Y. En estos casos, dado que el tamaño de la variable CHARACTER es variable, es preciso usar un interface block.
El Programa ejemplo_9_6.f90, Sección 9.3.6 es un ejemplo donde se construyen dos vectores de números aleatorios de dimensión definida por el usuario usando el método Box-Mueller. Para ello se definen dos matrices de tipo ALLOCATABLE, X e Y, y en la subrutina interna BOX_MULLER se definen dos vectores de tipo automático: RANDOM_u y RANDOM_v.
Para calcular el valor medio, la desviación estándar y la mediana de los vectores X e Y se hace uso de la subrutina STATS del Programa ejemplo_9_3.f90, Sección 9.3.3. Se incluye el necesario INTERFACE en el programa principal y la subrutina se debe compilar en un fichero por separado. Programa ejemplo_9_6.f90, Sección 9.3.6
Sí es importante tener en cuenta que en el caso que se transfiera un array usando assumed shape arguments como en los ejemplos, el primer índice de la variable en la subrutina se supone que comienza con el valor 1, a menos que explícitamente se indique lo contrario. En el ejemplo Programa ejemplo_9_7.f90, Sección 9.3.7 se muestra un caso simple donde es necesario indicar el índice inicial del vector cuando este no es cero. En este programa se calcula el factorial de los enteros entre IMIN e IMAX y se almacenan en un vector real. Se puede compilar y correr el programa haciendo IMIN = 1 e IMIN = 0 con y sin la definición del índice inicial en la subrutina, para ver la diferencia en las salidas.
PROGRAM ejemplo_9_1
!
IMPLICIT NONE
! Ejemplo simple de un programa con dos subrutinas.
! subrutina (1):: Interact :: Obtiente los coeficientes de la ec. de seg. grado.
! subrutina (2):: Solve :: Resuelve la ec. de seg. grado.
!
! Definicion de variables
REAL :: P, Q, R, Root1, Root2
INTEGER :: IFail=0
LOGICAL :: OK=.TRUE.
!
CALL Interact(P,Q,R,OK) ! Subrutina (1)
!
IF (OK) THEN
!
CALL Solve(P,Q,R,Root1,Root2,IFail) ! Subrutina (2)
!
IF (IFail == 1) THEN
PRINT *,' Complex roots'
PRINT *,' calculation aborted'
ELSE
PRINT *,' Roots are ',Root1,' ',Root2
ENDIF
!
ELSE
!
PRINT*,' Error in data input program ends'
!
ENDIF
!
END PROGRAM ejemplo_9_1
!
!
SUBROUTINE Interact(A,B,C,OK)
IMPLICIT NONE
REAL , INTENT(OUT) :: A
REAL , INTENT(OUT) :: B
REAL , INTENT(OUT) :: C
LOGICAL , INTENT(OUT) :: OK
INTEGER :: IO_Status=0
PRINT*,' Type in the coefficients A, B AND C'
READ(UNIT=*,FMT=*,IOSTAT=IO_Status)A,B,C
IF (IO_Status == 0) THEN
OK=.TRUE.
ELSE
OK=.FALSE.
ENDIF
END SUBROUTINE Interact
!
!
SUBROUTINE Solve(E,F,G,Root1,Root2,IFail)
IMPLICIT NONE
REAL , INTENT(IN) :: E
REAL , INTENT(IN) :: F
REAL , INTENT(IN) :: G
REAL , INTENT(OUT) :: Root1
REAL , INTENT(OUT) :: Root2
INTEGER , INTENT(INOUT) :: IFail
! Local variables
REAL :: Term
REAL :: A2
Term = F*F - 4.*E*G
A2 = E*2.0
! if term < 0, roots are complex
IF(Term < 0.0)THEN
IFail=1
ELSE
Term = SQRT(Term)
Root1 = (-F+Term)/A2
Root2 = (-F-Term)/A2
ENDIF
END SUBROUTINE Solve
PROGRAM ejemplo_9_2
!
IMPLICIT NONE
! Ejemplo simple de un programa con dos subrutinas.
! subrutina (1):: Interact :: Obtiente los coeficientes de la ec. de seg. grado.
! subrutina (2):: Solve :: Resuelve la ec. de seg. grado.
!
! Interface blocks
INTERFACE
SUBROUTINE Interact(A,B,C,OK)
IMPLICIT NONE
REAL , INTENT(OUT) :: A
REAL , INTENT(OUT) :: B
REAL , INTENT(OUT) :: C
LOGICAL , INTENT(OUT) :: OK
END SUBROUTINE Interact
SUBROUTINE Solve(E,F,G,Root1,Root2,IFail)
IMPLICIT NONE
REAL , INTENT(IN) :: E
REAL , INTENT(IN) :: F
REAL , INTENT(IN) :: G
REAL , INTENT(OUT) :: Root1
REAL , INTENT(OUT) :: Root2
INTEGER , INTENT(INOUT) :: IFail
END SUBROUTINE Solve
END INTERFACE
! Fin interface blocks
!
! Definicion de variables
REAL :: P, Q, R, Root1, Root2
INTEGER :: IFail=0
LOGICAL :: OK=.TRUE.
!
CALL Interact(P,Q,R,OK) ! Subrutina (1)
!
IF (OK) THEN
!
CALL Solve(P,Q,R,Root1,Root2,IFail) ! Subrutina (2)
!
IF (IFail == 1) THEN
PRINT *,' Complex roots'
PRINT *,' calculation aborted'
ELSE
PRINT *,' Roots are ',Root1,' ',Root2
ENDIF
!
ELSE
!
PRINT*,' Error in data input program ends'
!
ENDIF
!
END PROGRAM ejemplo_9_2
!
!
SUBROUTINE Interact(A,B,C,OK)
IMPLICIT NONE
REAL , INTENT(OUT) :: A
REAL , INTENT(OUT) :: B
REAL , INTENT(OUT) :: C
LOGICAL , INTENT(OUT) :: OK
INTEGER :: IO_Status=0
PRINT*,' Type in the coefficients A, B AND C'
READ(UNIT=*,FMT=*,IOSTAT=IO_Status)A,B,C
IF (IO_Status == 0) THEN
OK=.TRUE.
ELSE
OK=.FALSE.
ENDIF
END SUBROUTINE Interact
!
!
SUBROUTINE Solve(E,F,G,Root1,Root2,IFail)
IMPLICIT NONE
REAL , INTENT(IN) :: E
REAL , INTENT(IN) :: F
REAL , INTENT(IN) :: G
REAL , INTENT(OUT) :: Root1
REAL , INTENT(OUT) :: Root2
INTEGER , INTENT(INOUT) :: IFail
! Local variables
REAL :: Term
REAL :: A2
Term = F*F - 4.*E*G
A2 = E*2.0
! if term < 0, roots are complex
IF(Term < 0.0)THEN
IFail=1
ELSE
Term = SQRT(Term)
Root1 = (-F+Term)/A2
Root2 = (-F-Term)/A2
ENDIF
END SUBROUTINE Solve
PROGRAM ejemplo_9_3
!
IMPLICIT NONE
!
! Definicion de variables
INTEGER :: N
REAL , ALLOCATABLE , DIMENSION(:) :: X !! (1)
REAL :: M,SD,MEDIAN
INTEGER :: IERR
!
! interface block !! (2)
INTERFACE
SUBROUTINE STATS(VECTOR,N,MEAN,STD_DEV,MEDIAN)
IMPLICIT NONE
INTEGER , INTENT(IN) :: N
REAL , INTENT(IN) , DIMENSION(:) :: VECTOR !! (1)
REAL , INTENT(OUT) :: MEAN
REAL , INTENT(OUT) :: STD_DEV
REAL , INTENT(OUT) :: MEDIAN
END SUBROUTINE STATS
END INTERFACE
PRINT *,' Cuántos valores vas a generar aleatoriamente ?'
READ(*,*),N
ALLOCATE(X(1:N), STAT = IERR) !! (3)
IF (IERR /= 0) THEN
PRINT*, "X allocation request denied."
STOP
ENDIF
CALL RANDOM_NUMBER(X)
X=X*1000 !! (4)
CALL STATS(X,N,M,SD,MEDIAN)
!
PRINT *,' MEAN = ',M
PRINT *,' STANDARD DEVIATION = ',SD
PRINT *,' MEDIAN IS = ',MEDIAN
!
IF (ALLOCATED(X)) DEALLOCATE(X, STAT = IERR) !! (5)
IF (IERR /= 0) THEN
PRINT*, "X NON DEALLOCATED!"
STOP
ENDIF
END PROGRAM ejemplo_9_3
!
SUBROUTINE STATS(VECTOR,N,MEAN,STD_DEV,MEDIAN)
IMPLICIT NONE
! Defincion de variables
INTEGER , INTENT(IN) :: N
REAL , INTENT(IN) , DIMENSION(:) :: VECTOR !! (1)
REAL , INTENT(OUT) :: MEAN
REAL , INTENT(OUT) :: STD_DEV
REAL , INTENT(OUT) :: MEDIAN
REAL , DIMENSION(1:N) :: Y
REAL :: VARIANCE = 0.0
REAL :: SUMXI = 0.0, SUMXI2 = 0.0
!
SUMXI=SUM(VECTOR) !! (6)
SUMXI2=SUM(VECTOR*VECTOR) !! (6)
MEAN=SUMXI/N
VARIANCE=(SUMXI2-SUMXI*SUMXI/N)/(N-1)
STD_DEV = SQRT(VARIANCE)
Y=VECTOR
! Ordena valores por proceso de seleccion
CALL SELECTION
IF (MOD(N,2) == 0) THEN
MEDIAN=(Y(N/2)+Y((N/2)+1))/2
ELSE
MEDIAN=Y((N/2)+1)
ENDIF
CONTAINS !! (7)
SUBROUTINE SELECTION
IMPLICIT NONE
INTEGER :: I,J,K
REAL :: MINIMUM
DO I=1,N-1
K=I
MINIMUM=Y(I)
DO J=I+1,N
IF (Y(J) < MINIMUM) THEN
K=J
MINIMUM=Y(K)
END IF
END DO
Y(K)=Y(I)
Y(I)=MINIMUM
END DO
END SUBROUTINE SELECTION
END SUBROUTINE STATS
PROGRAM ejemplo_9_4
IMPLICIT NONE
REAL,DIMENSION(1:100)::A,B
INTEGER :: Nos,I
CHARACTER(LEN=32)::Filename
INTERFACE
SUBROUTINE Readin(Name,X,Y,N)
IMPLICIT NONE
INTEGER , INTENT(IN) :: N
REAL,DIMENSION(1:N),INTENT(OUT)::X,Y
CHARACTER (LEN=*),INTENT(IN)::Name
END SUBROUTINE Readin
END INTERFACE
PRINT *,' Type in the name of the data file'
READ '(A)' , Filename
PRINT *,' Input the number of items in the file'
READ(*,*) , Nos
CALL Readin(Filename,A,B,Nos)
PRINT * , ' Data read in was'
DO I=1,Nos
PRINT *,' ',A(I),' ',B(I)
ENDDO
END PROGRAM ejemplo_9_4
SUBROUTINE Readin(Name,X,Y,N)
IMPLICIT NONE
INTEGER , INTENT(IN) :: N
REAL,DIMENSION(1:N),INTENT(OUT)::X,Y
CHARACTER (LEN=*),INTENT(IN)::Name
INTEGER::I
OPEN(UNIT=10,STATUS='OLD',FILE=Name)
DO I=1,N
READ(10,*)X(I),Y(I)
END DO
CLOSE(UNIT=10)
END SUBROUTINE Readin
PROGRAM ejemplo_9_5
IMPLICIT NONE
REAL , ALLOCATABLE , DIMENSION &
(:,:)::One,Two,Three,One_T
INTEGER :: I,N
INTERFACE
SUBROUTINE Matrix_bits(A,B,C,A_T)
IMPLICIT NONE
REAL, DIMENSION (:,:), INTENT(IN) :: A,B
REAL, DIMENSION (:,:), INTENT(OUT) :: C,A_T
END SUBROUTINE Matrix_bits
END INTERFACE
PRINT *,'Dimensión de las matrices'
READ*,N
ALLOCATE(One(1:N,1:N))
ALLOCATE(Two(1:N,1:N))
ALLOCATE(Three(1:N,1:N))
ALLOCATE(One_T(1:N,1:N))
DO I=1,N
PRINT*, 'Fila ', I,' de la primer matriz?'
READ*,One(I,1:N)
END DO
DO I=1,N
PRINT*, 'Fila ', I,' de la segunda matriz?'
READ*,Two(I,1:N)
END DO
CALL Matrix_bits(One,Two,Three,One_T)
PRINT*,' Resultado: Matriz Producto:'
DO I=1,N
PRINT *,Three(I,1:N)
END DO
PRINT *,' Matriz traspuesta A^T:'! Calcula la matriz transpuesta.
DO I=1,N
PRINT *,One_T(I,1:N)
END DO
END PROGRAM ejemplo_9_5
!
SUBROUTINE Matrix_bits(A,B,C,A_T)
IMPLICIT NONE
REAL, DIMENSION (:,:), INTENT(IN) :: A,B
REAL, DIMENSION (:,:), INTENT(OUT) :: C,A_T
C=MATMUL(A,B)
A_T=TRANSPOSE(A)
END SUBROUTINE Matrix_bits
PROGRAM ejemplo_9_6
!
IMPLICIT NONE
!
INTEGER :: I, IERR
REAL, DIMENSION(:), ALLOCATABLE :: X, Y
REAL :: M, SD, MEDIAN
! interface block
INTERFACE
SUBROUTINE STATS(VECTOR,N,MEAN,STD_DEV,MEDIAN)
IMPLICIT NONE
INTEGER , INTENT(IN) :: N
REAL , INTENT(IN) , DIMENSION(:) :: VECTOR
REAL , INTENT(OUT) :: MEAN
REAL , INTENT(OUT) :: STD_DEV
REAL , INTENT(OUT) :: MEDIAN
END SUBROUTINE STATS
END INTERFACE
!
READ*, I
!
ALLOCATE(X(1:I), STAT = IERR)
IF (IERR /= 0) THEN
PRINT*, "X allocation request denied."
STOP
ENDIF
!
ALLOCATE(Y(1:I), STAT = IERR)
IF (IERR /= 0) THEN
PRINT*, "Y allocation request denied."
STOP
ENDIF
!
CALL BOX_MULLER(I)
!
PRINT*, X
CALL STATS(X,I,M,SD,MEDIAN)
!
PRINT *,' MEAN = ',M
PRINT *,' STANDARD DEVIATION = ',SD
PRINT *,' MEDIAN IS = ',MEDIAN
!
IF (ALLOCATED(X)) DEALLOCATE(X, STAT = IERR)
IF (IERR /= 0) THEN
PRINT*, "X NON DEALLOCATED!"
STOP
ENDIF
PRINT*, Y
CALL STATS(Y,I,M,SD,MEDIAN)
!
PRINT *,' MEAN = ',M
PRINT *,' STANDARD DEVIATION = ',SD
PRINT *,' MEDIAN IS = ',MEDIAN
!
IF (ALLOCATED(Y)) DEALLOCATE(Y, STAT = IERR)
IF (IERR /= 0) THEN
PRINT*, "Y NON DEALLOCATED!"
STOP
ENDIF
!
CONTAINS
!
SUBROUTINE BOX_MULLER(dim)
!
! Uses the Box-Muller method to create two normally distributed vectors
!
INTEGER, INTENT(IN) :: dim
!
REAL, PARAMETER :: PI = ACOS(-1.0)
REAL, DIMENSION(dim) :: RANDOM_u, RANDOM_v ! Automatic arrays
!
CALL RANDOM_NUMBER(RANDOM_u)
CALL RANDOM_NUMBER(RANDOM_v)
!
X = SQRT(-2.0*LOG(RANDOM_u))
Y = X*SIN(2*PI*RANDOM_v)
X = X*COS(2*PI*RANDOM_v)
!
END SUBROUTINE BOX_MULLER
!
END PROGRAM ejemplo_9_6
PROGRAM EJEMPLO_9_7
!
IMPLICIT NONE
!
INTERFACE
SUBROUTINE SUBEXAMPLE(IMIN, IMAX, FACT_MAT)
INTEGER, INTENT(IN) :: IMIN, IMAX
REAL, DIMENSION(IMIN:), INTENT(OUT) :: FACT_MAT
END SUBROUTINE SUBEXAMPLE
END INTERFACE
!
REAL, DIMENSION(:), ALLOCATABLE :: FACT_MAT
INTEGER :: IMIN, IMAX, I
!
IMIN = 0
IMAX = 5
!
ALLOCATE(FACT_MAT(IMIN:IMAX))
!
PRINT*, "MAIN", SIZE(FACT_MAT)
!
CALL SUBEXAMPLE(IMIN, IMAX, FACT_MAT)
!
DO I = IMIN, IMAX
PRINT*, I, FACT_MAT(I)
ENDDO
!
END PROGRAM EJEMPLO_9_7
!!!!!!!!!!
SUBROUTINE SUBEXAMPLE(IMIN, IMAX, FACT_MAT)
!
IMPLICIT NONE
INTEGER, intent(in) :: IMIN, IMAX
REAL, DIMENSION(IMIN:), intent(out) :: FACT_MAT
! The subroutine with the next line only would work for IMIN = 1
! REAL, DIMENSION(:), intent(out) :: FACT_MAT
!
INTEGER :: j,k
!
PRINT*, "SUB", SIZE(FACT_MAT)
!
DO j = imin, imax
fact_mat(j) = 1.0
do k = 2, j
fact_mat(j) = k*fact_mat(j)
enddo
ENDDO
!
!
END SUBROUTINE SUBEXAMPLE
[ anterior ] [ Contenidos ] [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ] [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 10 ] [ 11 ] [ 12 ] [ 13 ] [ siguiente ]
Lecciones de Fortran 90 para la asignatura Química Computacional
mailto:francisco.perez@dfaie.uhu.es