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


Fortran 90 Lessons for Computational Chemistry
Chapter 10 - Subprograms (III): modules


10.1 Objectives

The main aims of this session consist of:

  1. Presenting modules and their main pros.

  1. Use of modules for variable definition, replacing the deprecated COMMON block, a feature of FORTRAN 77.

  1. Use of modules to define and transmit functions and subroutines.

  1. Private and publice variables in a module: variable visibility.


10.2 Main items.

  1. Modules allow a clearer and more flexible code production. A module can encompass

    1. Global variables declaration.

      Modules in this regard replace the deprecated COMMON and INCLUDE FORTRAN 77 features.

    1. INTERFACE blocks declaration.

    1. Functions and subroutines declaration, avoiding the necessity of including INTERFACE blocks.

    1. Access control to the different variables, assigning public or private character.

    1. Modules allow to pack derived types, functions, subroutines and allow the development of an object oriented programming approach in FORTRAN.

    The syntax of a module declaration is as follows

         MODULE module_name
            IMPLICIT NONE
            [SAVE]
              Variable declarations
            [ CONTAINS
              Subprograms definition ]
         END MODULE  module_name
    

    The modules is loaded with the statement USE MODULE module_name that has to preceed the rest of the program statements. From a module another module can be called.

  1. Modules allow the transmission of variables between subprogram units without arguments. The other main role of modules is, making use of the CONTAINS statement, to define functions, subroutines and INTERFACE blocks.

    The subprograms inclusion in a module informs the compiler about all the details of them, allowing a fast error detection. Subroutines and functions in a module and accessed with USE MODULE it is said to be an explicit interface, whereas in other case it is said to have an implicit interface.

  1. The definition of modules favors the encapsulation of code, defining easily reusable code, which is the basis of object oriented programming.

  1. Modules are loaded from other programs or subprograms via the USE command.

  1. In order to define common variables for several program units the deprecated COMMON feature should be avoided. Instead the following steps are necessary

    1. Declare variables in a MODULE.

    1. Give the variables the SAVE attribute.

    1. Load the modue with the statement USE module_name) from those program units that should access the variables.

    As an example, if there are several physical constants that are used in severla programs we can define a module as follows

         MODULE PHYS_CONST
           !
           IMPLICIT NONE
           !
           SAVE
           !
           REAL, PARAMETER :: Light_Speed = 2.99792458E08  ! m/s
           REAL, PARAMETER :: Newton_Ctnt = 6.67428E-11    ! m3 kg-1 s-2
           REAL, PARAMETER :: Planck_Ctnt = 4.13566733E-15 ! eV s
           !
           REAL :: Other_variable
           !
         END MODULE PHYS_CONST
    

    In this module three physical constants are defined (with the PARAMETER attribute) and a fourth variable that is not kept constant. Any program unit that needs access to these variables only needs to load the module as follows

         PROGRAM CALCULUS
           !
           USE PHYS_CONST 
           !
           IMPLICIT NONE
           !
           REAL DISTANCE, TIME
           !
           ...
           DISTANCE = Light_Speed*TIME
           ...
           !
         END PROGRAM CALCULUS
    
  1. The use of modules allows a safe, portable, and flexible way of controlling the precision of the integer and real numbers in the program. A possible way to define in a protable way the precision of a given code is with a module like NUMERIC_KINDS included in excode_10_1_mod.f90, Section 10.3.2 and we can define the precision using this module

         PROGRAM TEST_MINUIT
           !
           USE NUMERIC_KINDS
           !
           IMPLICIT NONE
           !
           ! Variable Definition     
           REAL(KIND=dp), PARAMETER :: PI = 4.0_dp*ATAN(1.0_dp)
           REAL(KIND=dp) :: ENERF
            ....
            ....
    

    This solution enhances the portability of the code and is less error prone than individually defining the precision for each program unit. The example code excode_10_1.f90, Section 10.3.1 is the same than excode_9_6.f90, Section 9.3.6 apart from this improvement.

  1. In the source code excode_10_2_mod.f90, Section 10.3.4 we present a module, defined with the MODULE heading instead of PROGRAM, for the definition of an integers stack. In this case it is worth to notice the way the variables STACK_POS and STORE are defined, as PRIVATE variables and with the SAVE attribute.

         PROGRAM Use_Stack
         !
         USE Stack     ! Load the module 
         !
         IMPLICIT NONE
         ....
         ....
         CALL POP(23); CAL PUSH(20)
         ....
         ....
         END PROGRAM Use_Stack
    
  1. As shown in excode_10_2_mod.f90, Section 10.3.4, variables in a module can have either a private or a public character, using the PRIVATE/PUBLIC attributes. A private variable can not be accessed from the calling program unit. The program loading the module in the proposed example only can access the POP and PUSH subroutines. The default option is PUBLIC ant it's possible to define the attribute in the same line of the variable definition.

           INTEGER, PRIVATE, PARAMETER :: STACK_SIZE = 500
           INTEGER, PRIVATE, SAVE :: STORE(STACK_SIZE) = 0, STACK_POS = 0
    
  1. Sometimes it is possible that there are conflicts between a variable or a subprogram defined in a module are in conflict with variables or subprograms defined in the calling program unit. In order to avoid this problem there exists the possibility of renaming the module variables, though this is a last minute solution for desperate situations.

    If, for example, we call the module Stack from a main program that already has a variable called PUSH, we can rename the module PUSH object to STACK_PUSH when invoking the module.

         USE Stack, STACK_PUSH => PUSH
    

    Several objects can be simultaneously renamed, separating the list with commas.

  1. Es posible hacer que solo algunos elementos del módulo sean accesibles desde el programa que lo invoca con la cláusula ONLY, donde también es posible renombrar los objetos si es necesario. Por ejemplo, con la llamada

         USE Stack, ONLY: POP, STACK_PUSH => PUSH
    

    Solamente se accede a POP y PUSH, y este último se renombra a STACK_PUSH.

  1. Source code excode_10_2.f90, Section 10.3.3 is a simple program where module excode_10_2_mod.f90, Section 10.3.4 is used to handle a stack to perform integer sums and substraction in reversed Polish notation (RPN).

    The RPN does not require the use of parentheses and is faster than the usual algebraic notation. If the stack contains, from first to last, the numbers (23, 10, 33) and we take into account the principle tenemos en cuenta que un stack se rige por el principio last in, first out, tendremos que si introducimos un número más (p.e. 5) y realizamos las operaciones de suma (plus) y substracción (minus) tendremos lo siguiente

         -       -         -              -
         -       23        -              -
         23      10        23             -
         10      33        10             23
         33   ->  5   ->   38 (=33+5) -> -28 (=10-38)
         
         5      plus      minus
    

    Para llevar a cabo esta tarea se carga el módulo Stack en (1). Una vez cargado el módulo podemos acceder a las subrutinas POP y PUSH que nos permiten manejar el stack. En (2) comienza el bucle principal, con la etiqueta inloop, que termina cuando el usuario da como input Q, q o quit.

    Para controlar este bucle se utiliza una estructura SELECT CASE que comienza en (3). Esta estructura analiza cuatro casos posibles:

    En el último caso se transforma la variable de carácter leída en una variable entera para almacenarla en el stack.

    Para compilar y correr este programa podemos hacerlo compilando previamente el módulo, si lo hemos salvado en el fichero ejemplo_10_1_Stack.f90

         $ gfortran -c ejemplo_10_1_Stack.f90
         $ gfortran -o ejemplo_10_2 ejemplo_10_2.f90 ejemplo_10_1_Stack.o
    

    En un ejercicio se plantean al alumnos diferentes maneras de mejorar el programa simple excode_10_2.f90, Section 10.3.3.


10.3 Example codes.


10.3.1 excode_10_1.f90

     PROGRAM ex_10_1
       !
       USE NUMERIC_KINDS
       !
       IMPLICIT NONE
       !
       INTEGER :: I, IERR
       REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: X, Y
       REAL(KIND=dp) :: M, SD, MEDIAN
       ! interface block   
       INTERFACE
          SUBROUTINE STATS(VECTOR,N,MEAN,STD_DEV,MEDIAN)
            !
            USE NUMERIC_KINDS
            !
            IMPLICIT NONE
            INTEGER , INTENT(IN)                    ::  N
            REAL(KIND=dp)      , INTENT(IN) , DIMENSION(:)   :: VECTOR  
            REAL(KIND=dp)      , INTENT(OUT)                 :: MEAN
            REAL(KIND=dp)      , INTENT(OUT)                 :: STD_DEV
            REAL(KIND=dp)      , 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(KIND=dp), PARAMETER :: PI = ACOS(-1.0_dp)
         REAL(KIND=dp), DIMENSION(dim) :: RANDOM_u, RANDOM_v ! Automatic arrays
         !
         CALL RANDOM_NUMBER(RANDOM_u)
         CALL RANDOM_NUMBER(RANDOM_v)
         !
         X = SQRT(-2.0_dp*LOG(RANDOM_u))
         Y = X*SIN(2.0_dp*PI*RANDOM_v)
         X = X*COS(2.0_dp*PI*RANDOM_v)
         !
       END SUBROUTINE BOX_MULLER
       !
     END PROGRAM ex_10_1
     SUBROUTINE STATS(VECTOR,N,MEAN,STD_DEV,MEDIAN)
       USE NUMERIC_KINDS
       IMPLICIT NONE
       ! Defincion de variables
       INTEGER , INTENT(IN)                    ::  N
       REAL(KIND=dp)      , INTENT(IN) , DIMENSION(:)    ::  VECTOR    !! (1)
       REAL(KIND=dp)      , INTENT(OUT)                  ::  MEAN
       REAL(KIND=dp)      , INTENT(OUT)                  ::  STD_DEV
       REAL(KIND=dp)      , INTENT(OUT)                  ::  MEDIAN
       REAL(KIND=dp)      , DIMENSION(1:N)              ::  Y
       REAL(KIND=dp)      :: VARIANCE = 0.0_dp
       REAL(KIND=dp)      :: SUMXI = 0.0_dp, SUMXI2 = 0.0_dp
       !
       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

10.3.2 excode_10_1_mod.f90

     MODULE NUMERIC_KINDS
       ! 4, 2, AND 1 BYTE INTEGERS
       INTEGER, PARAMETER :: &
            i4b = SELECTED_INT_KIND(9), &
            i2b = SELECTED_INT_KIND(4), &
            i1b = SELECTED_INT_KIND(2)
       ! SINGLE, DOUBLE, AND QUADRUPLE PRECISION
       INTEGER, PARAMETER :: &
            sp = KIND(1.0), &
            dp = KIND(1.0D0), &
            qp = SELECTED_REAL_KIND(2*PRECISION(1.0_dp))
     END MODULE NUMERIC_KINDS

10.3.3 excode_10_2.f90

     PROGRAM RPN_CALC
       !
       ! SIMPLE INTEGER RPN CALCULATOR (ONLY SUM AND SUBSTRACT)
       !
       USE Stack                 !!        (1)
       !
       IMPLICIT NONE
       !
       INTEGER :: KEYB_DATA
       CHARACTER(LEN=10) :: INPDAT
       !
       INTEGER :: I, J, K, DATL, NUM, RES
       !
       !
       inloop: DO      !! MAIN LOOP        (2)
          !
          READ 100, INPDAT
          !
          SELECT CASE (INPDAT)   !!        (3)
             !
          CASE ('Q','q','quit')  !! EXIT          (4)
             PRINT*, "End of program"
             EXIT inloop
          CASE ('plus','Plus','PLUS','+')   !! SUM              (5)        
             CALL POP(J)
             CALL POP(K)
             RES = K + J
             PRINT 120, K, J, RES
             CALL PUSH(RES)
          CASE ('minus','Minus','MINUS','-')   !! SUBSTRACT        (6)
             CALL POP(J)
             CALL POP(K)
             RES = K - J
             PRINT 130, K, J, RES
             CALL PUSH(RES)
          CASE DEFAULT !! NUMBER TO STACK  (7)
             !
             DATL = LEN_TRIM(INPDAT)
             !
             RES = 0
             DO I = DATL, 1, -1
                NUM = IACHAR(INPDAT(I:I)) - 48
                RES = RES + NUM*10**(DATL-I)
             ENDDO
             !
             PRINT 110, RES
             CALL PUSH(RES)
          END SELECT
          !
       ENDDO inloop
       !
     100 FORMAT(A10)
     110 FORMAT(1X, I10)
     120 FORMAT(1X, I10,' + ', I10,' = ', I20)
     130 FORMAT(1X, I10,' - ', I10,' = ', I20)
     END PROGRAM RPN_CALC

10.3.4 excode_10_2_mod.f90

     MODULE Stack
       ! 
       ! MODULE THAT DEFINES A BASIC STACK
       !
       IMPLICIT NONE
       !
       SAVE
       !
       INTEGER, PARAMETER :: STACK_SIZE = 500
       INTEGER, DIMENSION(STACK_SIZE) :: STORE = 0
       INTEGER :: STACK_POS = 0
       !
       PRIVATE :: STORE, STACK_POS, STACK_SIZE
       PUBLIC :: POP, PUSH
       !
       CONTAINS
         !
         SUBROUTINE PUSH(I)
           !
           INTEGER, INTENT(IN) :: I
           !
           IF (STACK_POS < STACK_SIZE) THEN
              !
              STACK_POS = STACK_POS + 1; STORE(STACK_POS) = I
              !
           ELSE
              !
              STOP "FULL STACK ERROR"
              !
           ENDIF
           !
         END SUBROUTINE PUSH
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         SUBROUTINE POP(I)
           !
           INTEGER, INTENT(OUT) :: I
           !
           IF (STACK_POS > 0) THEN
              !
              I = STORE(STACK_POS); STACK_POS = STACK_POS - 1
              !
           ELSE
              !
              STOP "EMPTY STACK ERROR"
              !
           ENDIF
           !
         END SUBROUTINE POP
         !
     END MODULE Stack

[ 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