Hello everyone,
My name is Francisco Iglesias, I am 71 years old. I started my programming journey several decades ago with Fortran IV and Fortran 77. Although in recent years I have been exploring and enjoying the power of Python, I still hold a huge affection for Fortran, and I know that nowadays it is still very much alive in the scientific and supercomputing fields.
Before retiring, I created a personal library of functions to solve string manipulation limitations in Fortran 77. Today I want to share with the community one of my favorite routines: itrim.
What does this function do?
- Removes leading and trailing spaces.
- Reduces multiple intermediate spaces between words to an exact amount specified by the “k” parameter (for example, leaving exactly 1 space, 2 spaces, or 0 spaces to join everything).
- Most importantly: It respects and leaves intact multiple spaces that are inside strings protected by single quotes (') or double quotes (").
I know that many students or engineers today work with legacy systems in Fortran 77 and dealing with strings has always been a challenge in this standard. I hope this code is useful to someone.
Here is a test program and the complete function:
! program pruebaitrim
! implicit none
! character a*1024, itrim*1024, b*1024
! integer*4 l
! a = 'Esto es una prueba a ver como sale y determinar si '//
! * 'realmente funciona bien la ruutina para eliminar blancos '//
! * '"intermedios de una hola cadena de caracteres" '//
! * ' y ver ademas si "(respetamos las comillas) "'//
! * ' realmente respeta las cadenas encerradas entre comillas. '//
! * 'vamos a ver como sale este negocio. que mas puedo decir. '//
! * 'probemos y veamos que pasa'
! print*
! print*,'Original tal y como se escribio (sin itrim)'
! l = len_trim(a)
! print*,a(1:l)
! print*
! print*,'reducir espacios a uno 1'
! a = itrim (a,l,1)
! print*,a(1:l)
! print*
! print*,'reducir espacios a dos 2'
! a = itrim (a,l,2)
! print*,a(1:l)
! print*
! print*,'reducir espacios a cero 0'
! a = itrim (a,l,0)
! print*,a(1:l)
! b = itrim(a,0,0)
! print*,b(1:len_trim(b))
! stop
! end
c********************************************************************************
c* Rutina para eliminar espacios en blanco intermedios entre palabras en
c* una cadena de caracteres. Tambien se eliminan a la izquierda y derecha.
c* El tamaño total de la cadena no se puede reducir. Siempre sera igual al
c* tamaño definido en la instruccion CHARACTER.
c* El proceso consiste en suprimir los blancos a la izquierda y a la derecha
c* de la cadena de caracteres y suprimir todos aquellos espacios en blanco
c* innecesarios (mas de uno) que esten intermedios entre las palabras.
c* Se devuelve una cadena libre de espacios en blanco a la izquierda y a la
c* derecha y los espacios intermedios entre palabras estaran ajustados a lo
c* que se indique en el parametro “k”. De esta manera se pueden eliminar
c* todos los espacios en blanco o por el contrario, estos pueden ser sustituidos
c* por la cantidad de espacios indicados en el parametro “k”.
c* Si la variable “k” tiene el valor cero (0), entonces se eliminan todos los
c* espacios en blanco. La cadena devuelta estara libre de espacios en blanco.
c* Solo se respetan aquellos que esten entre comillas simples y/o dobles. Esto
c* significa que las cadenas de caracteres encerradas entre comillas se respetan
c* y se dejan tal cual estan. No se eliminan espacios en blanco entre comillas.
c*
c* Francisco Iglesias (Octubre-2024)
c********************************************************************************
character*(*) function itrim (a,k)
implicit none
character a*(*)
character blanco*1024, blanko(1024)*1 /1024*' '/
equivalence (blanco, blanko(1))
integer*4 n1, i, j, k
logical*4 sw, swc
itrim = a
n1 = len_trim (a)
if (n1 .eq. 0) return
if (k .gt. 20) k = 1
j = 1
do while (j .le. n1 .and. a(j:j) .eq. ' ') ! busca primer caracter no blanco
j = j + 1
enddo
if (j .gt. n1) return
sw = .false.
swc = .true.
i = 0
do j = j, n1
if (a(j:j) .eq. "'" .or. a(j:j) .eq. '"') swc = .not. swc
if (a(j:j) .eq. ' ' .and. swc) then
sw = .true. ! espacios intermedios
else
if (sw .and. k .gt. 0) then
itrim (i+1:i+k) = blanco (1:k)
i = i + k
sw = .false.
endif
i = i + 1
itrim (i:i) = a (j:j)
endif
enddo
if (i .lt. n1) itrim (i+1:) = blanco
return
end
Any comments, corrections, or suggestions to adapt it to more modern standards like Fortran 90/95 or 2018 are more than welcome. Warm regards to the new generations of Fortran programmers!