Skip to content

Commit 2a3f4bf

Browse files
authored
Merge pull request mouredev#7328 from LeandroCFD/main
#4 - Fortran
2 parents 485b0e8 + 735cfe8 commit 2a3f4bf

File tree

1 file changed

+140
-0
lines changed

1 file changed

+140
-0
lines changed
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,140 @@
1+
program CHARACTER
2+
implicit none
3+
4+
integer :: n,n1,n2,n3=0,n4=0,i
5+
character (len=30):: texto,texto1,texto2,texto5="",texto6=""
6+
character (len=10):: texto3,texto4
7+
character :: letra
8+
9+
texto1="Hola"
10+
texto2=" DeviDec"
11+
12+
!OPERACIONES CON CADENAS DE CARACTERES EN FORTRAN
13+
!Concatenación
14+
texto=trim(texto1)//trim(texto2) !trim elimina los espacios al final de la cadena
15+
print*,texto
16+
17+
!Longitud
18+
n=len(texto) !Longitud de la cadena "texto"
19+
print*,"La longitud de texto es: ",n
20+
n=len_trim(texto) !Longitud de la cadena "texto" sin espacios en blanco
21+
print*,"La longitud de texto sin espacios en blanco es: ",n
22+
23+
!Partes de cadenas
24+
texto=texto2(:4) !"texto" será lo que hay en la posición 1 hasta la 4 de la cadena "texto2"
25+
print*,texto
26+
texto=texto2(4:8) !"texto" será lo que hay en la posición 4 hasta la 8 de la cadena "texto2"
27+
print*,texto
28+
29+
!Posición de cadena de caracteres
30+
n=index(texto2,'Dec') !La función index busca la posición de la cadena "Dec" en la cadena "texto2"
31+
print*,"La posición de 'Dec' en texto2 es: ",n
32+
33+
!Posición de cualquier caracter dentro de una cadena
34+
n=scan(texto2, 'Hijo') !La función scan busca la posición de cualquier caracter de la cadena "Hijo" en "texto2"
35+
print*,"La posición de algún caracter de 'Hijo' en texto2 es: ",n !En este caso la letra i de "Hijo" se encuentra en la
36+
!posición 5 de la cadena "texto2"
37+
38+
!Conversión de tipos
39+
write(texto,'(I10)') n !Convierte un número entero en una cadena
40+
print*,texto
41+
texto2="9"
42+
read(texto2,'(I1)') n !Convierte una cadena a número entero
43+
print*,n
44+
45+
!Repetación
46+
texto=repeat(trim(texto1),5)
47+
print*,texto
48+
49+
!Reemplazo
50+
texto(5:)=" DeviDec" !Se reemplazan los caracteres de "texto" desde la posición 5 hasta el final por " DeviDec"
51+
print*,texto
52+
53+
!Verificación
54+
n=verify(texto, "Hola DeviFlow") !La función devuelve la posición del primer carácter en "texto" que no está en "Hola DeviFlow"
55+
print*,n !El unico caracter que esta en "texto" y que no esta en "Hola DeviFlow" es la c, que se encuentra en la posición 12
56+
57+
!Eliminación de espacios
58+
texto1=" Hola"
59+
texto=adjustl(texto1) !La función adjustl elimina todos los espacios en blanco de la izquierda de la cadena
60+
print*,texto1
61+
print*,texto
62+
texto3="Hola "
63+
texto4=" Devidec"
64+
texto=texto3//texto4
65+
print*,"Sin la función adjustr: ",texto
66+
texto=adjustr(texto3)//texto4 !La función adjustr elimina todos los espacios en blanco de la derecha de la cadena
67+
print*,"Con la función adjustr: ",texto
68+
texto=trim(texto3)//trim(texto4) !La función trim elimina todos los espacios en blanco de la cadena
69+
print*,"Con la función trim: ",texto
70+
71+
!DIFICULTAD EXTRA
72+
print*,"***********************************************************"
73+
print*,"PROGRAMA DE DETECCIÓN DE PALÍNDROMOS, ANAGRAMAS Y ISOGRAMAS"
74+
print*,"***********************************************************"
75+
print*,""
76+
print*,"Ingrese la primera palabra en minusculas: "
77+
read*,texto1
78+
print*,"Ingrese la segunda palabra en minusculas: "
79+
read*,texto2
80+
print*,""
81+
n1=len_trim(texto1) !Se determina la longitud de la cadena de texto
82+
n2=len_trim(texto2)
83+
84+
do i=1,n1
85+
texto5(i:i)=texto1(n1+1-i:n1+1-i) !Se escribe la cadena al reves
86+
letra=texto1(i:i) !Se guarda una letra de texto1
87+
n=scan(texto1(i+1:),letra) !Se revisa si la letra esta en otra parte de la cadena
88+
if (n/=0) then
89+
n3=n3+1 !Si la palabra texto1 NO es un anagrama n3/=0
90+
end if
91+
end do
92+
do i=1,n2
93+
texto6(i:i)=texto2(n2+1-i:n2+1-i) !Se realiza lo mismo para la cadena texto2
94+
letra=texto2(i:i)
95+
n=scan(texto2(i+1:),letra)
96+
if (n/=0) then
97+
n4=n4+1
98+
end if
99+
end do
100+
101+
!PALÍNDROMO
102+
if (texto5==texto1 .and. texto6==texto2) then
103+
print*,trim(texto1),": Es un palíndromo"
104+
print*,trim(texto2),": Es un palíndromo"
105+
else if (texto5==texto1) then
106+
print*,trim(texto1),": Es un palíndromo"
107+
print*,trim(texto2),": No es un palíndromo"
108+
else if (texto6==texto2) then
109+
print*,trim(texto1),": No es un palíndromo"
110+
print*,trim(texto2),": Es un palíndromo"
111+
else
112+
print*,trim(texto1),": No es un palíndromo"
113+
print*,trim(texto2),": No es un palíndromo"
114+
end if
115+
116+
!ANAGRAMA
117+
n=verify(texto1,texto2) !Se verifica si existe un caracter diferente entre texto1 y texto2
118+
119+
if (n==0) then
120+
print*,trim(texto1),": es un anagrama de ",trim(texto2)
121+
else
122+
print*,trim(texto1),": No es un anagrama de ",trim(texto2)
123+
end if
124+
125+
!ISOGRAMA
126+
if (n3==0 .and. n4==0) then
127+
print*,trim(texto1),": es un isograma"
128+
print*,trim(texto2),": es un isograma"
129+
else if (n3==0) then
130+
print*,trim(texto1),": es un isograma"
131+
print*,trim(texto2),": No es un isograma"
132+
else if (n4==0) then
133+
print*,trim(texto1),": No es un isograma"
134+
print*,trim(texto2),": es un isograma"
135+
else
136+
print*,trim(texto1),": No es un isograma"
137+
print*,trim(texto2),": No es un isograma"
138+
end if
139+
140+
end program CHARACTER

0 commit comments

Comments
 (0)