Skip to content

Commit 8bfec9b

Browse files
LeandroCFDLeandroCFD
committed
#3 - Fortran
1 parent 49b5f29 commit 8bfec9b

File tree

1 file changed

+274
-0
lines changed

1 file changed

+274
-0
lines changed

‎Roadmap/03 - ESTRUCTURAS DE DATOS/fortran/LeandroCFD.f90

Lines changed: 274 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,274 @@
1+
program ARRAYS
2+
implicit none
3+
4+
!Fortran permite la creación y manipulación de arreglos unidimensionales (vectores), bidimensionales (matrices) y
5+
!tridimensionales (grillas). Es importante entender que Fortran al momento de compilar convierte todos los tipos de arreglos a
6+
!arreglos unidimensionales. En Fortran es posible declarar los arreglos de forma estatica y de forma dinámica.
7+
!Declaración de arreglos unidimensionales de forma estatica.
8+
integer, dimension(5) :: vector1 !Declaración de un arreglo unidimensional de tipo integer que tiene dimensión 5.
9+
integer :: vector5(5) !También es posible declarar un arreglo añadiendo las dimensiones al nombre del arreglo.
10+
real, dimension(1:3) :: vector2 !Declaración de un arreglo unidimensional de tipo real que tiene dimensión 3 con indices 1 a 3
11+
character(len=20), dimension(5) :: nombres !Declaración de un arreglo unidimensional de tipo character que tiene dimensión 5 y
12+
!cada posición del arreglo tiene una longitud máxima de 20 caracteres.
13+
complex, dimension(10:15) :: vector3 !Declaración de un arreglo unidimensional de tipo complex, dimensión 5 indices 10 a 15
14+
logical, dimension(5:8) :: pruebas !!Declaración de un arreglo unidimensional de tipo logical que tiene dimensión 4 con
15+
!indices 5 a 8
16+
17+
!Declaración de arreglos bidimensionales de forma estatica.
18+
integer, dimension(5,3) :: matriz1 !Declaración de arreglo tipo integer que tiene dimensión 5 (filas) y 3 (columnas).
19+
real, dimension(1:5,1:3) :: matriz2 !Declaración de arreglo tipo real que tiene dimensión 5 (filas) y 3 (columnas)
20+
!con indices 1 a 5 y 1 a 3 respectivamente.
21+
character(len=20), dimension(2:4,5:7) :: nombres1 !Declaración de arreglo tipo character que tiene dimensión 3 (filas) y
22+
!3 (columnas) con indices 2 a 4 y 5 a 7 respectivamente, cada posición del arreglo tiene una longitud máxima de 20 caracteres.
23+
complex, dimension(1:5,6) :: matriz3 !Declaración de arreglo tipo complex que tiene dimensión 5 (filas) y 6 (columnas)
24+
!con indices 1 a 5 y sin asginación de indices para las columnas.
25+
logical, dimension(2,2:6) :: pruebas1 !!Declaración de arreglo de tipo logical que tiene dimensión 2 (filas) y 5 (columnas)
26+
!sin indices para las filas y con indices 2 a 6 para las columnas.
27+
28+
!Declaración de arreglos tridimensionales de forma estatica.
29+
integer, dimension(4,3,5) :: tensor1 !Declaración de arreglo tipo integer que tiene dimensión 4 (filas) , 3 (columnas) y
30+
!5 (matrices).
31+
real, dimension(1:10,1:7,1:4) :: tensor2,tensor4,tensor5 !Declaración de arreglo tipo real que tiene dimensión 10 (filas) y
32+
!7 (columnas) y 4 (matrices) con indices 1 a 10, 1 a 7 y 1 a 4 respectivamente.
33+
character(len=20), dimension(2:5,5:7,5) :: nombres3 !Declaración de arreglo tipo character que tiene dimensión 4 (filas),
34+
!3 (columnas) y 5 (matrices) con indices 2 a 4, 5 a 8 para filas y columnas y sin indices para las matrices, cada posición
35+
!del arreglo tiene una longitud máxima de 20 caracteres.
36+
complex, dimension(1:5,6,2:4) :: tensor3 !Declaración de arreglo tipo complex que tiene dimensión 5 (filas), 6 (columnas) y
37+
!3 (matrices) con indices 1 a 5 y 2 a 4 para filas y matrices y sin asginación de indices para las columnas.
38+
logical, dimension(2,2:6,4) :: pruebas2 !!Declaración de arreglo de tipo logical que tiene dimensión 2 (filas), 5 (columnas) y
39+
!4 (matrices) sin indices para las filas y matrices y con indices 2 a 6 para las columnas.
40+
41+
!En algunas ocasiones no es posible saber apriori el tamaño de un arreglo, por lo tanto, Fortran permite la declaración
42+
!de arreglos de forma dinámica con la opción allocatable.
43+
integer,dimension(:),allocatable :: vector4 !Arreglo unidimensional
44+
real,dimension(:,:),allocatable :: matriz4 !Arreglo bidimensional
45+
46+
!Declaraciones de variables ejercicio extra
47+
integer :: n,i,j,m
48+
character (len=100) :: comparacion
49+
type contacto
50+
character (len=100) :: nombre
51+
integer (kind=8):: telefono
52+
integer :: ID
53+
end type contacto
54+
55+
type (contacto), dimension(100) :: agenda
56+
57+
!La asignación de valores para los arreglos se puede realizar componente a componente.
58+
vector1(2)=100 !Se le asigna un valor de 100 a la posición 2 del vector1.
59+
vector2(3)=15.3 !Se le asigna un valor de 15.3 a la posición 3 del vector2.
60+
nombres(1)="Lizeth" !Se le asigna la cadena de texto "Lizeth" a la posición 1 del arreglo nombres.
61+
vector3(13)=(2,5) !Se le asigna un valor de (2,5) a la posición 13 del vector3.
62+
pruebas(7)=.true. !Se le asigna un valor true a la posición 7 del arreglo pruebas.
63+
64+
!También es posible asignar un arreglo de manera global de la siguiente manera.
65+
vector5=(/6,7,8,9,10/) !la asignación se realiza con los delimitadores / / y los valores deben ir separados por coma.
66+
print*,vector1
67+
matriz1=reshape([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15],[5,3]) !Para arreglos multidimensionales se debe utilizar la función
68+
!reshape que convierte un arreglo unidimensional en uno multidimnesional, Los valores dentro de los parentesis [] son los
69+
!valores del arreglo y el segundo parentesis las dimensiones.
70+
print*,matriz1 !Aunque es una matriz fortran lo imprime como un vector, esto debido a que Fortran solo utiliza arreglos
71+
!unidimensionales.
72+
matriz2=reshape([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15],[5,3])
73+
print*,matriz2(1,:) !Es posible imprimir una sola fila.
74+
print*,matriz2(:,1) !Es posible imprimir una sola columna.
75+
nombres1="Juan" !Es posible asignar un valor a todos los componentes de un arreglo.
76+
matriz3(2,:)=(5,3) !Es posible asignar un valor a todos los componentes de una fila en un arreglo.
77+
pruebas1(:,3)=.false. !Es posible asignar un valor a todos los componentes de una columna en un arreglo.
78+
tensor1(:,:,3)=100 !Es posible asignar un valor a todos los componentes de la matriz de un arreglo tridimensional.
79+
80+
!Operaciones aritmeticas
81+
tensor4=2
82+
tensor5=5
83+
tensor2=tensor4*tensor5 !multiplicación elemento a elemento de dos tensores
84+
tensor2=sqrt(tensor4)
85+
86+
!Intrucciones de control con arreglos
87+
where (tensor1==100) nombres3="Valor" !La instrución where permite asignar el valor a el arreglo nombres3 en las posiciones
88+
!donde tensor1==100.
89+
pruebas2=.true.
90+
pruebas=all(pruebas2) !La instrucción all devuelve un .true. si todos los elementos de pruebas2 son .true.
91+
print*,pruebas
92+
pruebas2=.false.
93+
pruebas=any(pruebas2) !La instrucción any devuelve un .true. si almenos un elemento de pruebas2 son .true.
94+
print*,pruebas
95+
tensor3=(5,3)
96+
97+
!Se le asigna el tamaño a los arreglos declarados dinámicamente con la sentencia allocate
98+
allocate(vector4(vector1(1):10),matriz4(tensor1(1,2,2),3))
99+
100+
!Se destruye un arreglo con la sentencia deallocate
101+
deallocate(matriz4)
102+
103+
!DIFICULTAD EXTRA
104+
agenda%ID=0
105+
menu : do i = 1, 100
106+
print*,"********************************************************"
107+
print*," MENU PRINCIPAL"
108+
print*,"********************************************************"
109+
print*,"********************************************************"
110+
print*,"BIENVENIDO A TU PROGRAMA DE AGENDA DE CONTACTOS PERSONAL"
111+
print*,"********************************************************"
112+
print*,""
113+
print*,"Digite un numero entre las siguientes opciones: "
114+
print*,""
115+
print*,"1. Agregar contacto"
116+
print*,"2. Eliminar contacto"
117+
print*,"3. Buscar contacto"
118+
print*,"4. Actualizar contacto"
119+
print*,"5. Ver todos los contactos"
120+
read*,n
121+
select case (n)
122+
case(1)
123+
print*,"Cada contacto tiene un número de identificación entre el 1 y el 100."
124+
print*,"Para agregar un contacto digite el número de identificación (ID) que usted desee:"
125+
read*,m
126+
do j= 1, 100
127+
if (m==agenda(j)%ID) then
128+
print*,"Este ID ya se encuentra reservado, si desea actualizarlo digite 4 en el menu principal"
129+
print*,""
130+
cycle menu
131+
end if
132+
end do
133+
agenda(m)%ID=m
134+
print*,"Ahora, escriba el nombre del contacto en minusculas:"
135+
read*,agenda(m)%nombre
136+
print*,"Ahora, escriba el número del contacto (no máximo de 11 digitos):"
137+
read*,agenda(m)%telefono
138+
print*,""
139+
print*,"**********************************"
140+
print*,"Contacto guardado correctamente!!!"
141+
print*,"**********************************"
142+
print*,""
143+
print*,"ID NOMBRE TELEFONO"
144+
print'(X,I0,14X,A,13X,I0)',agenda(m)%ID,trim(agenda(m)%nombre),agenda(m)%telefono
145+
print*,""
146+
print*,"¿Si deseas volver al menu principal digita 1 si deseas salir digita 2:"
147+
read*,m
148+
if ( m==1 ) then
149+
cycle menu
150+
else if ( m==2 ) then
151+
print*,"Gracias por utilizar nuestros servicios. Que tengas un bonito día!!!"
152+
exit menu
153+
end if
154+
case(2)
155+
print*,"Escriba el nombre del contacto que desea eliminar:"
156+
read*,comparacion
157+
do j = 1, 100
158+
if (comparacion==agenda(j)%nombre) then
159+
agenda(j)%ID=0
160+
agenda(j)%nombre=""
161+
agenda(j)%telefono=0
162+
print*,""
163+
print*,"***********************************"
164+
print*,"Contacto eliminado correctamente!!!"
165+
print*,"***********************************"
166+
print*,""
167+
print*,"¿Si deseas volver al menu principal digita 1 si deseas salir digita 2:"
168+
read*,m
169+
if ( m==1 ) then
170+
cycle menu
171+
else if ( m==2 ) then
172+
print*,"Gracias por utilizar nuestros servicios. Que tengas un bonito día!!!"
173+
exit menu
174+
end if
175+
end if
176+
end do
177+
print*,""
178+
print*,"*************************"
179+
print*,"Contacto NO encontrado!!!"
180+
print*,"*************************"
181+
print*,""
182+
print*,"Si deseas guardarlo como contacto nuevo digita 1 en el menu principal"
183+
print*,""
184+
cycle menu
185+
case(3)
186+
print*,"Escriba el nombre del contacto que deseas buscar:"
187+
read*,comparacion
188+
do j = 1, 100
189+
if (comparacion==agenda(j)%nombre) then
190+
print*,""
191+
print*,"************************************"
192+
print*,"Contacto encontrado correctamente!!!"
193+
print*,"************************************"
194+
print*,""
195+
print*,"ID NOMBRE TELEFONO"
196+
print'(X,I0,14X,A,13X,I0)',agenda(j)%ID,trim(agenda(j)%nombre),agenda(j)%telefono
197+
print*,""
198+
print*,"¿Si deseas volver al menu principal digita 1 si deseas salir digita 2:"
199+
read*,m
200+
if ( m==1 ) then
201+
cycle menu
202+
else if ( m==2 ) then
203+
print*,"Gracias por utilizar nuestros servicios. Que tengas un bonito día!!!"
204+
exit menu
205+
end if
206+
end if
207+
end do
208+
print*,""
209+
print*,"*************************"
210+
print*,"Contacto NO encontrado!!!"
211+
print*,"*************************"
212+
print*,""
213+
print*,"Si deseas guardarlo como contacto nuevo digita 1 en el menu principal"
214+
print*,""
215+
cycle menu
216+
case(4)
217+
print*,"Escriba el nombre del contacto que desea actualizar:"
218+
read*,comparacion
219+
do j = 1, 100
220+
if (comparacion==agenda(j)%nombre) then
221+
print*,"Digite el nuevo ID:"
222+
read*,agenda(j)%ID
223+
print*,"Digite el nuevo nombre en minusculas:"
224+
read*,agenda(j)%nombre
225+
print*,"Digite el nuevo número de telefono (no máximo de 11 digitos)"
226+
read*,agenda(j)%telefono
227+
print*,""
228+
print*,"***********************************"
229+
print*,"Contacto actualizado correctamente!!!"
230+
print*,"***********************************"
231+
print*,""
232+
print*,"ID NOMBRE TELEFONO"
233+
print'(X,I0,14X,A,13X,I0)',agenda(j)%ID,trim(agenda(j)%nombre),agenda(j)%telefono
234+
print*,""
235+
print*,"¿Si deseas volver al menu principal digita 1 si deseas salir digita 2:"
236+
read*,m
237+
if ( m==1 ) then
238+
cycle menu
239+
else if ( m==2 ) then
240+
print*,"Gracias por utilizar nuestros servicios. Que tengas un bonito día!!!"
241+
exit menu
242+
end if
243+
end if
244+
end do
245+
print*,""
246+
print*,"*************************"
247+
print*,"Contacto NO encontrado!!!"
248+
print*,"*************************"
249+
print*,""
250+
print*,"Si deseas guardarlo como contacto nuevo digita 1 en el menu principal"
251+
print*,""
252+
cycle menu
253+
case(5)
254+
print*,"Tus contactos son:"
255+
print*,""
256+
print*,"ID NOMBRE TELEFONO"
257+
do j = 1,100
258+
if ( agenda(j)%ID/=0 ) then
259+
print*,""
260+
print'(X,I0,14X,A,13X,I0)',agenda(j)%ID,trim(agenda(j)%nombre),agenda(j)%telefono
261+
end if
262+
end do
263+
print*,""
264+
print*,"¿Si deseas volver al menu principal digita 1 si deseas salir digita 2:"
265+
read*,m
266+
if ( m==1 ) then
267+
cycle menu
268+
else if ( m==2 ) then
269+
print*,"Gracias por utilizar nuestros servicios. Que tengas un bonito día!!!"
270+
exit menu
271+
end if
272+
end select
273+
end do menu
274+
end program ARRAYS

0 commit comments

Comments
 (0)