|
|
A STL vector type developed with FORTRAN
by: Máximo Fernández Cortizo and Javier Jiménez Shaw
Abstract:
This article deals with the development of a new vector type using
FORTRAN as programming language. The goal is to attain similar
features to the STL vector class (implemented in C++ as a template)
that is; grow at will, memory safe (with little more precautions than
using predefined FORTRAN 90 arrays) , speed and reusability. FORTRAN
preprocessor and operator overloading will be the tools used to
achieve the template features needed. This method can be used to
develop similar templates for other data storage classes as lists,
queues, maps etc.
This new vector type has been used with great success in the
development of engineering commercial software. The authors has found
this vector useful in the implementation of an object oriented
programming style in FORTRAN 90. A few samples extracted from real
life are provided within this article allowing to recognize the power
of this approach.
-We hope to complete this article as soon as possible. The source code you can download is complete.
-The source code is comented in Spanish. Soon will be in English.
Source Code
Download sample program (6 kb)
FortranTemplates.F90
!//////////////////////////////////////////////////////// !/// http://javier.jimenezshaw.com/fortrantemplates /// !//////////////////////////////////////////////////////// !**************************************************************************** ! ! FortranTemplates.f90 ! ! FUNCTIONS: ! FortranTemplates - Entry point of console application. ! ! !**************************************************************************** ! ! PROGRAM: FortranTemplates ! ! PURPOSE: Sample use of Template_vector in FORTRAN ! !**************************************************************************** program FortranTemplates use SAMPLE_TYPES use TEMPLATE_VECTOR_INTERFACES_MODULE implicit none TYPE(tVector2D) pair TYPE(T_Vector2D) vec, vec2 integer io,i pair.x = 3d0 pair.y = 5d0 Io=ADD_ELEMENT(vec,pair) pair.x = 0.5d0 pair.y = 9d0 Io=ADD_ELEMENT(vec,pair) pair.x = 3.14159d0 pair.y = 2.718281d0 Io=ADD_ELEMENT(vec,pair) Io=COPY(vec,vec2) Io=DEL_ELEMENT(vec2,2) do i=1,vec2.size write(*,*) vec2.v(i).x, vec2.v(i).y enddo call DEALLOC(vec) call DEALLOC(vec2) PAUSE end program FortranTemplates
Sample_Types.f90
!////////////////////////////////////////////////////////
!/// http://javier.jimenezshaw.com/fortrantemplates ///
!////////////////////////////////////////////////////////
!--------------------------------------------------------
!--------------------------------------------------------
! Fichero con la declaracion de los tipos vector que manejamos
! con las "templates", (MODULE TIPOS)
! de los tipos entero, doble y otro de ejemplo
! Está de ejemplo, y para incluir los tipod entero y doble.
! La continuación está en TEMPLATE_VECTOR_INTERFACES.f90
! Hay que completarlo con orden y concierto
!--------------------------------------------------------
#include "Template_vector_macros.inc"
!--------------------------------------------------------
MODULE SAMPLE_TYPES
IMPLICIT NONE
!////////////////////////////////////////////////
! 1.- Primero definimos el tipo contenedor usando _TYPE_
! Hay que ponerle un NOMBRE y el type del vector
!////////////////////////////////////////////////
_TYPE_(entero,integer)
_TYPE_(doble,doubleprecision)
!////////////////////////////////////////////////
! 2.- Tambien hay que definir el tipo del vector
!////////////////////////////////////////////////
type tVector2D
sequence
double precision x,y
end type tVector2D
_TYPE_(Vector2D,type(tVector2D))
!////////////////////////////////////////////////
! 3.- Declarar publicos todos los tipos:
! contenedor y vector
!////////////////////////////////////////////////
PUBLIC &
tVector2D ,&
T_Vector2D ,&
T_entero ,&
T_doble
END MODULE SAMPLE_TYPES
!////////////////////////////////////////////////
! Siguientes en TEMPLATE_VECTOR_INTERFACES.f90
!////////////////////////////////////////////////
Template_vector_ interfaces.f90
!//////////////////////////////////////////////////////// !/// http://javier.jimenezshaw.com/fortrantemplates /// !//////////////////////////////////////////////////////// !-------------------------------------------------------- !-------------------------------------------------------- ! Fichero con la declaracion de los tipos vector que manejamos ! con las "templates", (MODULE TIPOS) ! y los interfaces a las funciones para esos tipos ! (MODULE TEMPLATE_VECTOR_INTERFACES_MODULE) ! Hay que completarlo con orden y concierto !-------------------------------------------------------- !-------------------------------------------------------- #include "Template_vector_macros.inc" !-------------------------------------------------------- !//////////////////////////////////////////////// ! 1,2 y 3. en SAMPLE_TYPES.f90 !//////////////////////////////////////////////// MODULE TIPOS !//////////////////////////////////////////////// ! 4.- Incluir el modulo con los tipos definidos ! en este privilegiado lugar. !//////////////////////////////////////////////// USE SAMPLE_TYPES END MODULE TIPOS MODULE TEMPLATE_VECTOR_INTERFACES_MODULE USE TIPOS IMPLICIT NONE !//////////////////////////////////////////////// ! 5.- Declarar los interfaces a todas la funciones ! para todos los tipos definidos ! fijate en el NOMBRE y type !//////////////////////////////////////////////// interface ADD_ELEMENT INTERFACE_ADD_ELEMENT(Vector2D,type(tVector2D)) INTERFACE_ADD_ELEMENT(entero,integer) INTERFACE_ADD_ELEMENT(doble,doubleprecision) end interface interface DEL_ELEMENT INTERFACE_DEL_ELEMENT(Vector2D) INTERFACE_DEL_ELEMENT(entero) INTERFACE_DEL_ELEMENT(doble) end interface interface DEALLOC INTERFACE_DEALLOC(Vector2D) INTERFACE_DEALLOC(entero) INTERFACE_DEALLOC(doble) end interface interface RESIZE INTERFACE_RESIZE(Vector2D,type(tVector2D)) INTERFACE_RESIZE(entero,integer) INTERFACE_RESIZE(doble,doubleprecision) end interface interface COPY INTERFACE_COPY(Vector2D) INTERFACE_COPY(entero) INTERFACE_COPY(doble) end interface END MODULE TEMPLATE_VECTOR_INTERFACES_MODULE !----------------------------------------------------------------- ! Funciones sobrecargadas de ADD_ELEMENT ADD_ELEMENT(Vector2D,type(tVector2D)) ADD_ELEMENT(entero,integer) ADD_ELEMENT(doble,doubleprecision) ! Funciones sobrecargadas de DEL_ELEMENT DEL_ELEMENT(Vector2D) DEL_ELEMENT(entero) DEL_ELEMENT(doble) ! Subrutinas sobrecargadas de DEALLOC DEALLOC_M(Vector2D) DEALLOC_M(entero) DEALLOC_M(doble) ! Funciones sobrecargadas de RESIZE RESIZE(Vector2D,type(tVector2D)) RESIZE(entero,integer) RESIZE(doble,doubleprecision) ! Subrutinas sobrecargadas de COPY COPY(Vector2D) COPY(entero) COPY(doble) !//////////////////////////////////////////////// ! 7.- Fin !////////////////////////////////////////////////
Template_vector_macros.inc
!////////////////////////////////////////////////////////
!/// Template.inc ///////////////////////////////////////
!////////////////////////////////////////////////////////
!/// Macros para la definición de templates de///////////
!/// vectores bien gestionados. ////////////////////////
!////////////////////////////////////////////////////////
!/// Autores: Máximo Fernandez Cortizo //////////////////
!//////////// Javier Jiménez Shaw ///////////////////////
!////////////////////////////////////////////////////////
!/// 2002-10-03 // The power of partnership /////////////
!////////////////////////////////////////////////////////
!/// http://javier.jimenezshaw.com/fortrantemplates ///
!////////////////////////////////////////////////////////
!--------------------------------------------------------
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!@@@ ATENCIÓN: No puede haber espacios después @@@@@@@@@@
!@@@ de la \ de final de linea en las macros @@@@@@@@@@
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!@@@ Cuidado con el CaseSensitive @@@@@@@@@@
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!--------------------------------------------------------
! Hay que añadir en los settings, en el campo Fortran
! la siguiente opción de compilación (para que use
! correctamente el preprocesador)
! /fpp:"/m /extend_source 132 "
!--------------------------------------------------------
! Macro para definir el tipo padre
! Los tipos se llaman T_NOMBRE, siendo NOMBRE
!--------------------------------------------------------
#define _TYPE_(NOMBRE,TIPO) ;\
type T_##NOMBRE ;\
sequence ;\
integer size ;\
integer capacity ;\
TIPO,pointer:: v(:) ;\
end type
!--------------------------------------------------------
!--------------------------------------------------------
!--------------------------------------------------------
! Interface de ADD_ELEMENT
!--------------------------------------------------------
#define INTERFACE_ADD_ELEMENT(NOMBRE,TIPO) ;\
INTEGER FUNCTION ADD_ELEMENT_##NOMBRE (T,i) ;\
USE TIPOS ;\
TYPE(T_##NOMBRE) T ;\
TIPO i ;\
END FUNCTION ADD_ELEMENT_##NOMBRE
!--------------------------------------------------------
! Funcion ADD_ELEMENT que añade un elemento al vector
!--------------------------------------------------------
! Argumentos de la Macro:
! NOMBRE : nombre asignado al tipo contenedor T_NOMBRE (ver macro _TYPE_)
! TIPO : tipo del vector (por ejemplo TYPE(integer) ó INTEGER)
! Argumentos de la función:
! T : Estructura contenedor
! i : elemento (del tipo correspondiente) a insertar.
! Return : T%size
!--------------------------------------------------------
! Se puede utilizar en estructuras con arboles de punteros \
! ya que el puntero auxiliar reapunta a las ramas apuntadas por el original \
!--------------------------------------------------------
#define ADD_ELEMENT(NOMBRE,TIPO) ;\
INTEGER FUNCTION ADD_ELEMENT_##NOMBRE (T,i) ;\
USE TIPOS ;\
USE DFWBASE ;\
IMPLICIT NONE ;\
TYPE(T_##NOMBRE) T ;\
TIPO i ;\
TIPO,POINTER::v_aux(:) ;\
IF(.NOT.ASSOCIATED(T%v)) THEN ;\
ALLOCATE(T%v(1)) ;\
T%size = 1 ;\
T%capacity = 1 ;\
T%v(1)=i ;\
ELSEIF(T%size < T%capacity )THEN ;\
T%size = T%size + 1 ;\
T%v(T%size)=i ;\
ELSE ;\
T%capacity = T%size*2 ;\
ALLOCATE(v_aux(T%size)) ;\
CALL ZeroMemory(LOC(v_aux),sizeof(v_aux)) ;\
v_aux = T%v ;\
DEALLOCATE??????????????(T%v) ;\
ALLOCATE (T%v(T%capacity)) ;\
CALL ZeroMemory(LOC(T%v),sizeof(T%v)) ;\
T%v(1:T%size) = v_aux(1:T%size) ;\
DEALLOCATE(v_aux) ;\
T%size = T%size + 1 ;\
T%v(T%size) = i ;\
ENDIF ;\
ADD_ELEMENT_##NOMBRE = T%size ;\
END FUNCTION ADD_ELEMENT_##NOMBRE
!--------------------------------------------------------
!--------------------------------------------------------
!--------------------------------------------------------
! Interface de DEL_ELEMENT
!--------------------------------------------------------
#define INTERFACE_DEL_ELEMENT(NOMBRE) ;\
INTEGER FUNCTION DEL_ELEMENT_##NOMBRE (T,pos) ;\
USE TIPOS ;\
TYPE(T_##NOMBRE) T ;\
INTEGER pos ;\
END FUNCTION DEL_ELEMENT_##NOMBRE
!--------------------------------------------------------
! Funcion DEL_ELEMENT que añade un elemento al vector
!--------------------------------------------------------
! Argumentos de la Macro:
! NOMBRE : nombre asignado al tipo contenedor T_NOMBRE (ver macro _TYPE_)
! Argumentos de la función:
! T : Estructura contenedor
! pos: posicion de la que se quiere eliminar un elemento
! Return : T%size
!
! COMENTARIOS
! 1) Al borrar elementos no se disminuye capacity en nigun momento
! 2) Al no tener un destructor para punteros T no puede ser un pointer,
! si se pone pointer hay deallocatarlo antes
!--------------------------------------------------------
#define DEL_ELEMENT(NOMBRE) ;\
INTEGER FUNCTION DEL_ELEMENT_##NOMBRE(T,pos) ;\
USE TIPOS ;\
USE DFWBASE ;\
IMPLICIT NONE ;\
TYPE(T_##NOMBRE) T ;\
INTEGER pos ;\
IF(.NOT.ASSOCIATED(T%v)) THEN ;\
DEL_ELEMENT_##NOMBRE = -1 ;\
RETURN ;\
ELSEIF (T%size< 1) THEN ;\
DEL_ELEMENT_##NOMBRE = -1 ;\
RETURN ;\
ELSEIF (pos > T%size .OR. pos < 1 ) THEN ;\
DEL_ELEMENT_##NOMBRE = -1 ;\
RETURN ;\
ENDIF ;\
T%v(pos:T%size-1) = T%v(pos+1:T%size) ;\
CALL ZeroMemory(LOC(T%v(T%size)),Sizeof(T%v(T%size))) ;\
T%size = T%size -1 ;\
DEL_ELEMENT_##NOMBRE = T%size ;\
END FUNCTION DEL_ELEMENT_##NOMBRE
!--------------------------------------------------------
!--------------------------------------------------------
!--------------------------------------------------------
! Interface de DEALLOC
!--------------------------------------------------------
#define INTERFACE_DEALLOC(NOMBRE) ;\
SUBROUTINE DEALLOC_##NOMBRE (T) ;\
USE TIPOS ;\
TYPE(T_##NOMBRE) T ;\
END SUBROUTINE DEALLOC_##NOMBRE
!--------------------------------------------------------
! Argumentos de la Macro:
! NOMBRE : nombre asignado al tipo contenedor T_NOMBRE (ver macro _TYPE_)
! Argumentos de la función:
! T : Estructura contenedor a deallocatar
! Return : Nada, es una subrutina
!--------------------------------------------------------
! COMENTARIOS
! Deallocata el puntero, y pone todo a 0
! no pasa nada por deallocatar algo deallocatado
! El ZeroMemory substituye a
! T%size = 0
! T%capacity = 0
!--------------------------------------------------------
#define DEALLOC_M(NOMBRE) ;\
SUBROUTINE DEALLOC_##NOMBRE(T) ;\
USE TIPOS ;\
USE DFWBASE ;\
IMPLICIT NONE ;\
TYPE(T_##NOMBRE) T ;\
IF(ASSOCIATED(T%v)) DEALLOCATE (T%v);\
CALL ZeroMemory(LOC(T),sizeof(T)) ;\
END SUBROUTINE DEALLOC_##NOMBRE
!--------------------------------------------------------
!--------------------------------------------------------
! Interface de RESIZE
!--------------------------------------------------------
#define INTERFACE_RESIZE(NOMBRE,TIPO) ;\
INTEGER FUNCTION RESIZE_##NOMBRE (T,size,i) ;\
USE TIPOS ;\
TYPE(T_##NOMBRE) T ;\
INTEGER size ;\
TIPO i ;\
OPTIONAL i ;\
END FUNCTION RESIZE_##NOMBRE
!--------------------------------------------------------
! Funcion RESIZE modifica (aumenta) el tamaño del vector, y rellena
!--------------------------------------------------------
! Argumentos de la Macro:
! NOMBRE : nombre asignado al tipo contenedor T_NOMBRE (ver macro _TYPE_)
! TIPO : tipo del vector (por ejemplo TYPE(integer) ó INTEGER)
! Argumentos de la función:
! T : Estructura contenedor
! size : tamaño a dar
! i : elemento (del tipo correspondiente) a insertar (OPTIONAL).
! Return : T%size
!--------------------------------------------------------
! Muy util si sabes el tamaño que va a tener.
! Conserva los datos que tenía, si tenía alguno
! T puedes estar deallocatado, claro
! Si tiene tamaño de más, no hace nada
! Si viene i (PRESENT) se rellena hasta size con i's
! Devuelve T%capacity
!--------------------------------------------------------
#define RESIZE(NOMBRE,TIPO) ;\
INTEGER FUNCTION RESIZE_##NOMBRE(T,size,i) ;\
USE TIPOS ;\
USE DFWBASE ;\
IMPLICIT NONE ;\
TYPE(T_##NOMBRE) T ;\
INTEGER size ;\
TIPO i ;\
OPTIONAL i ;\
TIPO,POINTER::v_aux(:) ;\
;\
IF(size< 1) THEN ;\
RESIZE_##NOMBRE = -1 ;\
RETURN ;\
ENDIF ;\
;\
IF(.NOT.ASSOCIATED(T%v)) THEN ;\
IF(size>0)THEN ;\
ALLOCATE(T%v(size)) ;\
CALL ZeroMemory(LOC(T%v),sizeof(T%v)) ;\
ENDIF ;\
T%size = size ;\
T%capacity = size ;\
ELSEIF(T%capacity >= size)THEN ;\
IF(size>T%size) THEN ;\
T%?????????A?size = size ;\
ENDIF ;\
ELSE ;\
T%capacity = size ;\
ALLOCATE(v_aux(T%size)) ;\
CALL ZeroMemory(LOC(v_aux),sizeof(v_aux)) ;\
v_aux (1:T%size) = T%v(1:T%size) ;\
DEALLOCATE(T%v) ;\
ALLOCATE (T%v(T%capacity));\
CALL ZeroMemory(LOC(T%v),sizeof(T%v)) ;\
T%v(1:T%size) = v_aux(1:T%size) ;\
DEALLOCATE(v_aux) ;\
T%size = size ;\
ENDIF ;\
;\
IF(PRESENT(i))THEN ;\
T%v(1:size)=i ;\
T%size = size ;\
ENDIF ;\
;\
RESIZE_##NOMBRE = T%capacity;\
END FUNCTION RESIZE_##NOMBRE
!--------------------------------------------------------
!--------------------------------------------------------
! Interface de COPY
!--------------------------------------------------------
#define INTERFACE_COPY(NOMBRE) ;\
INTEGER FUNCTION COPY_##NOMBRE (T1,T2) ;\
USE TIPOS ;\
TYPE(T_##NOMBRE) T1,T2 ;\
END FUNCTION COPY_##NOMBRE
!--------------------------------------------------------
! Funcion COPY copia una estructura en otra
!--------------------------------------------------------
! Argumentos de la Macro:
! NOMBRE : nombre asignado al tipo contenedor T_NOMBRE (ver macro _TYPE_)
! TIPO : tipo del vector (por ejemplo TYPE(integer) ó INTEGER)
! Argumentos de la función:
! T1 : Estructura origen (el original del que se copia)
! T2 : Estructura destino (en el que se va a copiar)
! Return : T2%size
!--------------------------------------------------------
! Copia una estructura en otra.
! Empieza machacando deallocatando la T2. Cuidado si viene con basura
! Cuidado si tiene subpointers dentro. Es tu responsabilidad,
! esto copia tambien el puntero correspondiente.
!--------------------------------------------------------
#define COPY(NOMBRE) ;\
INTEGER FUNCTION COPY_##NOMBRE(T1,T2) ;\
USE TIPOS ;\
USE DFWBASE ;\
IMPLICIT NONE ;\
TYPE(T_##NOMBRE) T1,T2 ;\
;\
IF(ASSOCIATED(T2%v)) DEALLOCATE(T2%v) ;\
IF(T1%size< 1) THEN ;\
T2%capacity = 0 ;\
T2%size = 0 ;\
COPY_##NOMBRE = 0 ;\
RETURN ;\
ENDIF ;\
;\
T2%capacity = T1%size ;\
T2%size = T1%size ;\
ALLOCATE(T2%v(T2%size)) ;\
T2%v(1:T2%size) = T1%v(1:T1%size) ;\
;\
COPY_##NOMBRE = T2%size ;\
END FUNCTION COPY_##NOMBRE
!--------------------------------------------------------