[ previous ] [ Contents ] [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ] [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 10 ] [ 11 ] [ 12 ] [ 13 ] [ next ]

# `Fortran 90` Lessons for Computational Chemistry Chapter 9 - Subprograms (II): subroutines

## 9.1 Objectives

The main aims of this session consist of:

1. considering the differences between functions and subroutines and in what cases are the latter useful.

1. introducing the user to the subroutine definition procedures.

1. explaining subroutine arguments roles.

1. defining the commands CALL and INTERFACE.

1. explaining the scope of the variables of a subroutine and the role of local variables and of variables with the SAVE attribute.

1. presenting the different ways of passing an array as an argument to a subroutine.

1. defining the so called automatic arrays.

## 9.2 Main items.

1. The use of subroutines favors a structured programming through the definition of subtasks and avoiding code duplication. Together with functions, they make possible to access to an extense collection of libraries for multiple applications.

1. To better explain this point we will make use of a simple example: solving a second order equation. A possible way of dividing this task in simpler subtasks is as follows

1. Main program.

1. Equation coefficient input.

1. Solution of the algebraic equation.

1. Solution output.

The program excode_9_1.f90, Section 9.3.1 follows closely this scheme with two subroutines: Interact and Solve.

1. The syntax to define a subroutine is as follows

```       SUBROUTINE subroutine_name(arguments [optional])
IMPLICIT NONE
Arguments (dummy variables) definition (INTENT)
...
Local variables definition
...
Execution Section
...
[RETURN]
END SUBROUTINE  subroutine_name
```

Argumentos are called dummy because their definition is not followed by a memory assignment, this assignment will take place once the subroutine is called.

Each subroutine is compiled in a separate way by the compiler, what allows for the use of local variables that may have the same name in different subroutines and the main program without clashing due to the different scopes.

This scheme can be seen in program excode_9_1.f90, Section 9.3.1.

1. A subroutine is invoked with the CALL command as follows

```     CALL subroutine_name(arguments [optional])
```

Once the subroutine is executed the program flow returns to the program unit where the subroutine was invoked, after the CALL statement. The subroutine determines when to return to the invoking unit once the RETURN statement is found or if the subroutine execution ends.

1. The subroutine and the main program data flow takes place through the arguments, also called subroutine parameters. Arguments in the subroutine definition are dummy variables, with an associated type but no space reserved in memory. For example, the E, F, and G arguments in the Solve subroutine in the code excode_9_1.f90, Section 9.3.1 are of REAL type, but without any memory allocation. Only when the subroutine is invoked with the CALL Solve(P,Q,R,Root1,Root2,IFail) command the arguments E, F, and G are replaced by pointers to the main program variables P, Q, and R. This is why it is of great importance that the data type of variables and arguments match correctly.

1. Some of the arguments provide the necessary input for the subroutine, while others are output arguments that send the subroutine results to the invoking program unit. Mixed character input/output arguments can also be used.

Those parameters that are only input parameters should be defined using the INTENT(IN) attribute that, as it is the case with functions, indicate that the argument values cannot be altered in the subroutine.

If the parameters are output, the arguments should be defined with the INTENT(OUT) attribute, to avoid taking into account the input value of the argument.

Mixed character arguments should be defined with the INTENT(INOUT) attribute.

The subroutine Solve in example excode_9_1.f90, Section 9.3.1 provides examples for the three cases. It is advisable to label with the corresponding INTENT attribute every argument.

1. In order to facilitate the accordance between variables in the invoking program unit and the subroutine the user can defined the so called interface blocks. The example excode_9_2.f90, Section 9.3.2 is the same code than excode_9_1.f90, Section 9.3.1 to which interface blocks have been added for the Interact and Solve subroutines.

1. As in the case of functions, those variables defined in a subroutine that are not arguments are considered as local variables. For example, the Interact subroutine in excode_9_1.f90, Section 9.3.1 has a local variable called IO_Status.

In general the local variables are created once the subroutine is called and the value is lost unless they possess the SAVE attribute, that makes possible to store the variable value from one call to the next. For example

```     INTEGER, SAVE:: It = 0
```

The variable It value is kept among different calls to the subroutine.

As it is the case for functions, it is possible that the subprogram has access to the main program variables making use of the CONTAINS statement. This solution can be hard to scale once programs acquire certain size and it is not very advisable.

1. When the argument of a subroutine is of array type it is necessary to provide some extra information about the matrix to avoid the possible access of the subroutine to wrong memory areas. In order to achieve this there are three possible ways of specifying the dimensiones of an array included in a subroutine list of arguments.

1. explicit-shape approach:

In this case the dimensions of the matrices are included as arguments in the subroutine call and the matrices are declared making use of these arguments. For example, if in a subroutine called test_pass an input vector (space_vec_in) and an output vector (space_vec_out) with equal dimensions are used, if we make use of the explicit-shape approach the subroutine starts as follows

```     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
```
1. assumed-shape approach:

The main difference with the previous case is that either the corresponding INTERFACE block is added or, as explained in Subprograms (III): modules, Chapter 10, the subroutine is embedded in a module.

The example code excode_9_3.f90, Section 9.3.3 calculates the mean, the median, the variance and the standard deviation of a set of random numbers following a continuous uniform distribution. Several points of interest has been marked in the program.

• (1-3) Dynamic memory storage using the ALLOCATABLE attribute and the ALLOCATE statement. Notice that the array is a vector (DIMENSION(:)) and this piece of info needs to be also include in the interface block. The use of the interface block in cases like this one is mandatory. The statement (3), ALLOCATE(X(1:N), STAT = IERR) defines the length of the X vector. We also use the optional field STAT to check whether the array has been correctly dimensioned or not. Only if the output of this field, in the IERR variable, is zero the dynamic allocation has worked flawlessly.

```       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
```

It is important to take into account that an argument of a subroutine can have the ALLOCATABLE attribute, as well as local subroutine variables, but not dummy variables.

The assumed shape arguments are nonexistent in ```FORTRAN 77```, and it is the recommended form of transmitting arguments between a main program and a subprogram. In this form there is no transmitted information about the dimension of the array, and the argument and the main program variable need to have equal type, range, and class (KIND).

• (4) and (6): these statements take advantage of the `Fortran 90` rules to work with vector and arrays.

• (5) In this statement the allocated memory is revoked and freed using the DEALLOCATE statement. This is not mandatory in programs like the present example, though it is necessary to do so when the allocatable array has been defined in a function of subroutine without the SAVE attribute.

• (7) The CONTAINS statement is used to make the sorting subroutine SELECTION have access to the variables of the STATS subroutine. This is why in the SELECTION subroutine with the sorting algorithm only local variables need to be defined.

The definition of INTERFACE blocks is a task simplified making use of modules, that are introduced in the next chapter.

1. assumed-size approach

This case is not advised due to the lack of info in the subroutine about the matrix dimensiones. This makes easy to make errors of difficult diagnose. Its use is not encouraged.

1. Multidimensional arrays. The source code excode_9_5.f90, Section 9.3.5 is an example of how to pass multidimensional arrays as arguments of a subroutine as assumed shape arrays. The user defines two arrays , A and B, and the program computes the C array as the matrix product A times B. Then, the program computes the transpose matrix of A. The program makes use of the `Fortran 90` functions MATMUL and TRANSPOSE.

1. Subroutines can contain automatic arrays, that may depend on the subroutine argument values. These are local array that may not have the SAVE attribute. They are created when the subroutine is invoked and destroyed when the execution flow leaves the subroutine. It is preferable to use ALLOCATABLE arrays.

1. An argument of CHARACTER type is also diffenrent in the sense that if such argument is declared with a length LEN = *, once the subroutine is called the variable length is the legth of the variable in the call.

The code excode_9_4.f90, Section 9.3.4 is a program to which a file name is given and the number of data pairs stored in the file. The program opens the file and reads the two-column dataset. Notice that, due to the variable size of the CHARACTER variable, the interface block is required.

The example excode_9_6.f90, Section 9.3.6 caluculate two pseudo random number vectors with a Gaussian or normal distribution with a dimension defined by the user. This is achieved with the Box-Mueller method.

Two ALLOCATABLE arrays, X and Y are difined and in the internal subroutine BOX_MULLER two vectors of automatic type are defined: RANDOM_u and RANDOM_v.

The mean value, the median and the standard deviation are computed making use of the STATS subroutine in the source code excode_9_3.f90, Section 9.3.3. The necessary INTERFACE block is included in the main program and the subroutine should be compiled in a separate file.

1. It is important to take into account that when array arguments are used as assumed shape arguments the first index of the variable in the subroutine by default takes a value 1, unless it is explicitly indicated. The example excode_9_7.f90, Section 9.3.7 is a simple case where this initial value is indicated. This program cmputes the factorial of the integers in the range between IMIN and IMAX, storing them in a real vector. The program can be compiled making IMIN = 1 or IMIN = 0 with and without the definition of the initial index in the subroutine to check the different outputs.

## 9.3 Example Codes

### 9.3.1 excode_9_1.f90

```     PROGRAM ex_9_1
!
IMPLICIT NONE
! Simple program with two subroutines.
! subroutine (1):: Interact :: Data input.
! subroutine (2):: Solve :: Solve second order Eq.
!
! 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 ex_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'
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
```

### 9.3.2 excode_9_2.f90

```     PROGRAM ex_9_2
!
IMPLICIT NONE
! Simple program with two subroutines.
! subroutine (1):: Interact :: Data input.
! subroutine (2):: Solve :: Solve second order Eq.
!
! 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
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! 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 ex_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'
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
```

### 9.3.3 excode_9_3.f90

```     PROGRAM ex_9_3
!
IMPLICIT NONE
!
! 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 *,' Length of random values vector ?'
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 ex_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
```

### 9.3.4 excode_9_4.f90

```     PROGRAM ex_9_4
IMPLICIT NONE
REAL,DIMENSION(1:100)::A,B
INTEGER :: Nos,I
CHARACTER(LEN=32)::Filename
INTERFACE
IMPLICIT NONE
INTEGER , INTENT(IN) :: N
REAL,DIMENSION(1:N),INTENT(OUT)::X,Y
CHARACTER (LEN=*),INTENT(IN)::Name
END INTERFACE
PRINT *,' Type in the name of the data file'
PRINT *,' Input the number of items in the file'
PRINT * , ' Data read in was'
DO I=1,Nos
PRINT *,' ',A(I),' ',B(I)
ENDDO
END PROGRAM ex_9_4
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
END DO
CLOSE(UNIT=10)
```

### 9.3.5 excode_9_5.f90

```     PROGRAM ex_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 *,'Matrix Dimension?'
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*, 'Row ', I,'-th of the first array?'
END DO
DO I=1,N
PRINT*, 'Row ', I,'-th of the second array?'
END DO
CALL Matrix_bits(One,Two,Three,One_T)
PRINT*,' Result: Matrix Product'
DO I=1,N
PRINT *,Three(I,1:N)
END DO
PRINT *,' Transpose A^T:'
DO I=1,N
PRINT *,One_T(I,1:N)
END DO
END PROGRAM ex_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
```

### 9.3.6 excode_9_6.f90

```     PROGRAM ex_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
!
!
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 ex_9_6
!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE STATS(VECTOR,N,MEAN,STD_DEV,MEDIAN)
IMPLICIT NONE
! Arguments
INTEGER , INTENT(IN)                    ::  N
REAL      , INTENT(IN) , DIMENSION(:)    ::  VECTOR    !! (1)
REAL      , INTENT(OUT)                  ::  MEAN
REAL      , INTENT(OUT)                  ::  STD_DEV
REAL      , INTENT(OUT)                  ::  MEDIAN
! Local Variables
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
! Sort values
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
```

### 9.3.7 excode_9_7.f90

```     PROGRAM ex_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
!
! Variables
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 ex_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
```

[ previous ] [ Contents ] [ 1 ] [ 2 ] [ 3 ] [ 4 ] [ 5 ] [ 6 ] [ 7 ] [ 8 ] [ 9 ] [ 10 ] [ 11 ] [ 12 ] [ 13 ] [ next ]

`Fortran 90` Lessons for Computational Chemistry

0.0

Curro Pérez-Bernal `mailto:francisco.perez@dfaie.uhu.es`