IPN

IPN
IPN-ESIQIE

lunes, 7 de junio de 2010

MATRIZ DE GAUSS TRIANGULARIZACION POR MEDIO DE SUBRUTINAS

program gauss
implicit none
REAL,DIMENSION(:,:),ALLOCATABLE::M
REAL,DIMENSION(:),ALLOCATABLE::D,X
INTEGER::i,k,j,L,g,N
PRINT*,'Este programa resuelve ecuaciones simltaneas'
PRINT*,'por el metodo de Gauss'
PRINT*,'M representa lamatriz del sistema'
PRINT*,'D representa a lamatriz de terminos independientes'
!
!
PRINT*,'DE CUANTAS ECUACIONES CONSTA TU SISTEMA'
READ*,N
!
!
ALLOCATE(M(N,N),D(N),X(N))
DO i=1,N,1
PRINT*,'Intoroduce los elementos de la matriz del sistema, fila',i
do k=1,N,1
PRINT*,'Introduce el elemento c(',i,',',k,')='
READ*,M(i,k)
END DO
!
PRINT *,'Intoroduce los elementos de la matriz terminos independientes'
READ*,D(i)
END DO
DO L=1,N-1,1
CALL ELIMINACION (M,D,X,N)
WRITE (*,*)'EL VECTOR SOLUCION ES'
WRITE (*,*)X(L)
DEALLOCATE (M,D,X)
WRITE(*,*)'NO SUFICIENTE ESPACIO MEMORIA'
STOP
END DO
END PROGRAM gauss
!
!
SUBROUTINE ELIMINACION (M,D,X,N)
IMPLICIT NONE
INTEGER::N,i,j,k,G
REAL(KIND=8)::PIVOTE,BASE,SUMA
REAL,DIMENSION(N)::D,X
REAL,DIMENSION(N,N)::M
!
!===============================================
!ESTA PARTE DEL PROGRAMA USA UN METODO CONVERSION DE UNA MATRIZ A DE COEFICIENTES
!A UNA TRIANGULAR SUPERIOR
DO k=1,N,1
PIVOTE=M(N,N)
DO i=K+1,N,1
BASE=M(i,K)
DO j=1,N,1
M(i,j)=(M(i,j)-(BASE/PIVOTE)*(M(k,j)))
END DO
G=D(i)-(BASE/PIVOTE)*D(k)
END DO
END DO
!
!METODO PARA LA SUSTITUCION HACIA ATARS PARA EL CALCULO DEL VECTOR SOLUCION X
DO k=1,N,i
SUMA=0
DO j=N,k+1,-1
SUMA=SUMA+M(k,j)*X(j)
END DO
X(j)=(D(j)-SUMA/(M(k,k)))
END DO
RETURN
END SUBROUTINE ELIMINACION

INSTITUTO POLITECNICO NACIONAL


ESCUELA SUPERIOR DE INGENIERIA QUIMICA E INDUSTRIAS EXTRACTIVAS

PROYECTO:
CONVERTIDOR DE UNIDADES

ASIGNATURA: COMPUTACIÓN

-OBJETIVOS-
Que el alumno aplique los conocimientos obtenidos en clase y tenga la capacidad de desarrollar programas donde pueda efectuar conversiones de unidades aritméticas del sistema internacional de unidades (SI) al sistema ingles o en su caso a otras unidades equivalentes del SI.
-METAS-
Las metas de este proyecto son que el programa presentado a continuación tenga la capacidad de hacer conversiones en diferentes escalas. Las unidades que deseamos convertir son de:
-Temperatura
-Fuerza
- Longitud
- Área
- Masa
Tomaremos en cuenta las diferentes equivalencias y algunos factores de conversión como es el caso de las temperaturas.

INVESTIGACION TEORICA-
El fin de este proyecto como es mencionado es realizar un convertidor de unidades en un mismo programa a la cual podemos realizarnos una serie de preguntas ¿Cómo elegir únicamente una conversión?, ¿Qué tipo de herramientas nos ofrece fortran para alcanzar dicha meta?
Estas respuestas se presentaran a continuación debido a que por medio de esta investigación se podrá desarrollar el programa que contenga las características deseadas.

Como principio de la investigación haremos una diferencia en las posibles estructuras actualmente tenemos tres
• Secuenciales
• Repetitivas
• Selección

Estructura secuencial: es aquella en la que una acción (instrucción) sigue otra secuencia y las tareas se suceden una a otra por lo cual esta presenta una entrada y salida





Estructura repetitiva: son aquellas que retornan si no de da solución a un problema o cuando existe multibifurcacion.

Estructura de selección: se da cuando se tiene una descripción de instrucciones complicadas con un extenso número de posibilidades a seguir, y esta se usan para estructurar decisiones o alternativas. Es esta se evalúan condiciones usando expresiones lógicas.


Las que atrapan nuestra atención son las del carácter selectivo ya que en nuestro problema se tiene una gama de opciones la cual puede tener solución a través de un menú. Después de revisar varias fuentes como libros e internet encontramos dos métodos para formular un menú del cual se selecciono uno de ellos para llegar a dicha decisión se muestran sus diferencias y aplicaciones razones por las cuales se tomo la decisión de elaborar con esta subrutina. El programa que se presenta en esta ocasión esta basado en un tema llamado estructuras de programación.

En clases anteriormente vistas se obtuvo el conocimiento de construcciones de selección como es el uso del bloque IF (si – entonces). Al pedir a nuestro programa que realice más operaciones con determinados valores lógicos frecuentemente se desarrollan programas con este tipo de secuencias.

Aunque como desventaja tiene la exclusión de sentencias ya que solo se realiza un de ellas; es decir al cumplirse una de ellas el resto de las expresiones se anulan. Dentro de un bloque IF se pueden escribir otros bloques internos si es que se tienen más opciones a escoger.

Estructura básica de IF




A pesar de las propiedades que el bloque IF ofrece a fortran 90/95 tenemos otra manera de proporcionar control como es la aplicación del bloque select case (según _sea, caso de/case).
El bloque case a diferencia del IF permite que el usuario elija la operación a realizar y la secuencia que este quiera llevar con determinados valores. Ahora que se tienen las diferencias diremos con seguridad que podemos realizar nuestro convertidor con el uso de la expresión lógica SELECT CASE. Del que a continuación hablaremos con más detalles.

Como ya se había explicado select case nos permite escoger entre distintas opciones las aplicaciones que se le dan en programación como la resolución de ecuaciones cuadráticas o desplegar diferentes series con un mismo numero. Esta construcción se utiliza para elegir la ejecución de una secuencia de de sentencias pero no solo entre dos alternativas, si no entre varias.
La selección se apoya en el resultado obtenido en la aplicación de un criterio a una expresión de tipo entero o carácter .
Para poder dar seguimiento al desarrollo de nuestro programa seguimos la siguiente estructura básica
SELCT CASE (criterio)
CASE (valor 1)
Secuencia de sentencias2
CASE (valor2)
Secuencia de sentencias
CASE (valor n)
Secuencia de sentenciasn

END SELECT

Tambien podemos reopresentarlo a tarves del siguiente digrama de flujo.



CONCLUSIONES



Para finalizar y tomando en cuenta la investigación teórica desarrollada puedo concluir que en casos como este es de mayo utilidad la aplicación de select case ya que se evita escribir un exceso de sentencias con el uso de IF además de que da como resultado un mejor orden y presentación de nuestro programa sin dar problemas de entendimiento. El select case mejora la toma de decisiones que realiza un usuario al manejar su programa.
La problemática al realizar el programa fue al escribir las diferentes posibilidades que podían darse entre cada unidad.


Bibliografía:
Garcia Merayo, Félix, lenguaje de programación fortran 90, ed. Parauninfo año 1995 pag 63-64
http://www.desarrolloweb.com/articulos/1550.php

T

programa q realiza conversion de unidades para fortran 90/95 con ayuda del menu case



CODIGO
! Last change: IPN 1 Mar 2010 11:23 am
program proyecto
implicit none
integer::op,opm,opml,opt,optc,opf,opfc,opa,opac,opl,oplc
real::m,t,a,f,l,mc,tc,fc,ac,lc

write(*,*)"Convertidor de unidades"
write(*,*)"Selecciona una opcion"
write(*,*)"1.- Convertir unidades de Masa"
write(*,*)"2.- Convertir unidades de Temperatura"
write(*,*)"3.- Convertir unidades de Fuerza"
write(*,*)"4.- Convertir unidades de Superficie (area)"
write(*,*)"5.- Convertir unidades de Longitud"
read*,op
!selección del caso para la conversión de unidades
select case(op)
!caso para la conversión de unidades de masa
case(1)
write(*,*)"Selecciona en que unidad vas a meter la Masa"
write(*,*)"1.- Kilogramo"
write(*,*)"2.- Libra"
write(*,*)"3.- Tonelada americana"
write(*,*)"4.- Tonelada inglesa"
write(*,*)"5.- Tonelada metrica"
write(*,*)"6.- Gramos"
read*,opm
!selección del caso para la conversión de unidades de masa
select case(opm)
!caso para la conversión de kilogramos
case(1)
write(*,*)"Dame la cantidad en Kilogramos"
read*,m
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Libra"
write(*,*)"2.- Tonelada americana"
write(*,*)"3.- Tonelada inglesa"
write(*,*)"4.- Tonelada metrica"
write(*,*)"5.- Gramos"
read*,opml
!selección del caso para unidad de conversión
select case(opml)
case(1)
mc=m*2.205
write(*,*)"Tu conversion de",m,"Kg es",mc,"lb"
case(2)
mc=(m*2.205)/2000
write(*,*)"Tu conversion de",m,"Kg es",mc,"Ton americana"
case(3)
mc=(m*2.205)/2240
write(*,*)"Tu conversion de",m,"Kg es",mc,"Ton inglesa"
case(4)
mc=m/1000
write(*,*)"Tu conversion de",m,"Kg es",mc,"Ton metrica"
case(5)
mc=m*1000
write(*,*)"Tu conversion de",m,"Kg es",mc,"g"
case default
write(*,*)"Opcion no valida"
end select
!caso para la conversión de libra
case(2)
write(*,*)"Dame la cantidad en libras"
read*,m
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Kilogramos"
write(*,*)"2.- Tonelada americana"
write(*,*)"3.- Tonelada inglesa"
write(*,*)"4.- Tonelada metrica"
write(*,*)"5.- Gramos"
read*,opml
!selección del caso para unidad de conversión
select case(opml)
case(1)
mc=m/2.205
write(*,*)"Tu conversion de",m,"lb es",mc,"Kg"
case(2)
mc=m/2000
write(*,*)"Tu conversion de",m,"lb es",mc,"Ton americana"
case(3)
mc=m/2240
write(*,*)"Tu conversion de",m,"lb es",mc,"Ton inglesa"
case(4)
mc=(m/2.205)/1000
write(*,*)"Tu conversion de",m,"lb es",mc,"Ton metrica"
case(5)
mc=(m/2.205)*1000
write(*,*)"Tu conversion de",m,"lb es",mc,"g"
case default
write(*,*)"Opcion no valida"
end select
!caso para la conversión de Tonelada americana
case(3)
write(*,*)"Dame la cantidad en Toneldas americanas"
read*,m
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Kilogramos"
write(*,*)"2.- libras"
write(*,*)"3.- Tonelada inglesa"
write(*,*)"4.- Tonelada metrica"
write(*,*)"5.- Gramos"
read*,opml
!selección del caso para unidad de conversión
select case(opml)
case(1)
mc=(m*2000)/2.205
write(*,*)"Tu conversion de",m,"Ton americana es",mc,"Kg"
case(2)
mc=m*2000
write(*,*)"Tu conversion de",m,"Ton americana es",mc,"lb"
case(3)
mc=(m*2000)/2240
write(*,*)"Tu conversion de",m,"Ton americana es",mc,"Ton inglesa"
case(4)
mc=((m*2000)/2.205)/1000
write(*,*)"Tu conversion de",m,"Ton americana es",mc,"Ton metrica"
case(5)
mc=((m*2000)/2.205)*1000
write(*,*)"Tu conversion de",m,"Ton americana es",mc,"g"
case default
write(*,*)"Opcion no valida"
end select
!caso para la conversión de Tonelada inglesa
case(4)
write(*,*)"Dame la cantidad en Toneldas inglesas"
read*,m
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Kilogramos"
write(*,*)"2.- libras"
write(*,*)"3.- Tonelada americana"
write(*,*)"4.- Tonelada metrica"
write(*,*)"5.- Gramos"
read*,opml
!selección del caso para unidad de conversión
select case(opml)
case(1)
mc=(m*2240)/2.205
write(*,*)"Tu conversion de",m,"Ton inglesa es",mc,"Kg"
case(2)
mc=m*2240
write(*,*)"Tu conversion de",m,"Ton inglesa es",mc,"lb"
case(3)
mc=(m*2240)/2000
write(*,*)"Tu conversion de",m,"Ton inglesa es",mc,"Ton americana"
case(4)
mc=((m*2240)/2.205)/1000
write(*,*)"Tu conversion de",m,"Ton inglesa es",mc,"Ton metrica"
case(5)
mc=((m*2240)/2.205)*1000
write(*,*)"Tu conversion de",m,"Ton inglesa es",mc,"g"
case default
write(*,*)"Opcion no valida"
end select
!caso para la conversión de Tonelada metrica
case(5)
write(*,*)"Dame la cantidad en Toneldas metrica"
read*,m
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Kilogramos"
write(*,*)"2.- libras"
write(*,*)"3.- Tonelada americana"
write(*,*)"4.- Tonelada inglesa"
write(*,*)"5.- Gramos"
read*,opml
!selección del caso para unidad de conversión
select case(opml)
case(1)
mc=m*1000
write(*,*)"Tu conversion de",m,"Ton metrica es",mc,"Kg"
case(2)
mc=m*1000*2.205
write(*,*)"Tu conversion de",m,"Ton metrica es",mc,"lb"
case(3)
mc=(m*1000*2.205)/2000
write(*,*)"Tu conversion de",m,"Ton metrica es",mc,"Ton americana"
case(4)
mc=(m*1000*2.205)/1000
write(*,*)"Tu conversion de",m,"Ton metrica es",mc,"Ton inglesa"
case(5)
mc=m*1000*1000
write(*,*)"Tu conversion de",m,"Ton metrica es",mc,"g"
case default
write(*,*)"Opcion no valida"
end select
!caso para la conversión de gramos
case(6)
write(*,*)"Dame la cantidad en Gramos"
read*,m
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Kilogramos"
write(*,*)"2.- libras"
write(*,*)"3.- Tonelada americana"
write(*,*)"4.- Tonelada inglesa"
write(*,*)"5.- Tonelada metrica"
read*,opml
!selección del caso para unidad de conversión
select case(opml)
case(1)
mc=m/1000
write(*,*)"Tu conversion de",m,"Gramos es",mc,"Kg"
case(2)
mc=(m/1000)*2.205
write(*,*)"Tu conversion de",m,"Gramos es",mc,"lb"
case(3)
mc=((m/1000)*2.205)/2000
write(*,*)"Tu conversion de",m,"Gramos es",mc,"Ton americana"
case(4)
mc=((m/1000)*2.205)/1000
write(*,*)"Tu conversion de",m,"Gramos es",mc,"Ton inglesa"
case(5)
mc=(m/1000)/1000
write(*,*)"Tu conversion de",m,"Gramos es",mc,"Ton metrica"
case default
write(*,*)"Opcion no valida"
end select
case default
write(*,*)"Opción no valida"
!fin de caso de conversión de masa
end select
!case para la conversión de unidades de temperatura
case(2)
write(*,*)"Selecciona la unidad en la que vas a meter la Temperatura"
write(*,*)"1.- Celcius"
write(*,*)"2.- Farenheit"
write(*,*)"3.- Kelvin"
write(*,*)"4.- Rankine"
read*,opt
!selección del caso para la conversión de unidades de temperatura
select case(opt)
!caso para la coversión de grados Celcius
case(1)
write(*,*)"Dame los grados celcius"
read*,t
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Farenheit"
write(*,*)"2.- Kelvin"
write(*,*)"3.- Rankine"
read*,optc
!selección del caso para unidad de conversión
select case(optc)
case(1)
tc=t*1.8+32
write(*,*)"Tu conversion de",t,"ªC es",tc,"ºF"
case(2)
tc=t+273.15
write(*,*)"Tu conversion de",t,"ªC es",tc,"ºK"
case(3)
tc=((9/5)*t)+491.67
write(*,*)"Tu conversion de",t,"ªC es",tc,"ºR"
case default
write(*,*)"Opción no valida"
end select
case(2)
write(*,*)"Dame los grados Farenheit"
read*,t
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Celcius"
write(*,*)"2.- Kelvin"
write(*,*)"3.- Rankine"
read*,optc
!selección del caso para unidad de conversión
select case(optc)
case(1)
tc=(t-32)/1.8
write(*,*)"Tu conversion de",t,"ºF es",tc,"ºC"
case(2)
tc=((t-32)/1.8)+273.15
write(*,*)"Tu conversion de",t,"ºF es",tc,"ºK"
case(3)
tc=((9/5)*((t-32)/1.8))+491.67
write(*,*)"Tu conversion de",t,"ºF es",tc,"ºR"
case default
write(*,*)"Opción no valida"
end select
case(3)
write(*,*)"Dame los grados Kelvin"
read*,t
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Celcius"
write(*,*)"2.- Farenheit"
write(*,*)"3.- Rankine"
read*,optc
!selección del caso para unidad de conversión
select case(optc)
case(1)
tc=t-273.15
write(*,*)"Tu conversion de",t,"ºK es",tc,"ºC"
case(2)
tc=(t-273.15)*1.8+32
write(*,*)"Tu conversion de",t,"ºK es",tc,"ºF"
case(3)
tc=((9/5)*(t-273.15))+491.67
write(*,*)"Tu conversion de",t,"ºK es",tc,"ºR"
case default
write(*,*)"Opción no valida"
end select
case(4)
write(*,*)"Dame los grados Rankine"
read*,t
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Celcius"
write(*,*)"2.- Farenheit"
write(*,*)"3.- Kelvin"
read*,optc
!selección del caso para unidad de conversión
select case(optc)
case(1)
tc=((9/5)*t)-273.15
write(*,*)"Tu conversion de",t,"ºR es",tc,"ºC"
case(2)
tc=(((9/5)*t)-273.15)*1.8+32
write(*,*)"Tu conversion de",t,"ºR es",tc,"ºF"
case(3)
tc=(((9/5)*t)-273.15)+273.15
write(*,*)"Tu conversion de",t,"ºR es",tc,"ºk"
case default
write(*,*)"Opción no valida"
end select
case default
write(*,*)"Opción no valida"
!fin del caso para la conversión de temperaturas
end select
!caso para la conversión de unidades de fuerza
case(3)
write(*,*)"Selecciona la unidad en la que vas a meter la Fuerza"
write(*,*)"1.- Newton"
write(*,*)"2.- Dina"
write(*,*)"3.- Kilogramo-fuerza o Kilopondio"
write(*,*)"4.- libra-fuerza"
read*,opf
!selección del caso para la conversión de unidades de fuerza
select case(opf)
case(1)
write(*,*)"Dame la magnitud de la fuerza en Newton"
read*,f
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Dina"
write(*,*)"2.- Kilogramo-fuerza o Kilopondio"
write(*,*)"3.- libra-fuerza"
read*,opfc
!selección del caso para la unidad de conversión
select case(opfc)
case(1)
fc=f*(10**5)
write(*,*)"Tu conversion de",f,"N es",fc,"dyn"
case(2)
fc=f/9.80665
write(*,*)"Tu conversion de",f,"N es",fc,"Kgf o Kp"
case(3)
fc=f/4.448222
write(*,*)"Tu conversion de",f,"N es",fc,"lbf"
case default
write(*,*)"Opción no valida"
end select
case(2)
write(*,*)"Dame la magnitud de la fuerza en Dinas"
read*,f
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Newton"
write(*,*)"2.- Kilogramo-fuerza o Kilopondio"
write(*,*)"3.- libra-fuerza"
read*,opfc
!selección del caso para la unidad de conversión
select case(opfc)
case(1)
fc=f/(10**5)
write(*,*)"Tu conversion de",f,"dyn es",fc,"N"
case(2)
fc=(f/(10**5))/9.80665
write(*,*)"Tu conversion de",f,"dyn es",fc,"Kgf o Kp"
case(3)
fc=(f/(10**5))/4.448222
write(*,*)"Tu conversion de",f,"dyn es",fc,"lbf"
case default
write(*,*)"Opción no valida"
end select
case(3)
write(*,*)"Dame la magnitud de la fuerza en Kilogramo-fuerza o Kilopondio"
read*,f
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Newton"
write(*,*)"2.- Dina"
write(*,*)"3.- libra-fuerza"
read*,opfc
!selección del caso para la unidad de conversión
select case(opfc)
case(1)
fc=f*9.80665
write(*,*)"Tu conversion de",f,"Kgf o Kp es",fc,"N"
case(2)
fc=(f*9.80665)*(10**5)
write(*,*)"Tu conversion de",f,"Kgf o Kp es",fc,"dyn"
case(3)
fc=(f*9.80665)/4.448222
write(*,*)"Tu conversion de",f,"Kgf o Kp es",fc,"lbf"
case default
write(*,*)"Opción no valida"
end select
case(4)
write(*,*)"Dame la magnitud de la fuerza en libra-fuerza"
read*,f
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Newton"
write(*,*)"2.- Dina"
write(*,*)"3.- kilogramo-fuerza o Kilopondio"
read*,opfc
!selección del caso para la unidad de conversión
select case(opfc)
case(1)
fc=f*4.448222
write(*,*)"Tu conversion de",f,"lbf es",fc,"N"
case(2)
fc=(f*4.448222)*(10**5)
write(*,*)"Tu conversion de",f,"lbf es",fc,"dyn"
case(3)
fc=(f*9.80665)/9.80665
write(*,*)"Tu conversion de",f,"lbf es",fc,"Kgf o Kp"
case default
write(*,*)"Opción no valida"
end select
!fin del caso para la conversión de unidades de fuerza
end select
!caso para la conversión de unidades de area o superficie
case(4)
write(*,*)"Selecciona la unidad en la que vas a meter el Area"
write(*,*)"1.- Metro cuadrado"
write(*,*)"2.- Barn"
write(*,*)"3.- Hectárea"
write(*,*)"4.- Pie cuadrado"
write(*,*)"5.- Pulgada cuadrada"
write(*,*)"6.- Yarda cuadrada"
write(*,*)"7.- Centímetro cuadrado"
read*,opa
!selección del caso para la conversión de unidades de Area
select case(opa)
!caso para la coversión de Area
case(1)
write(*,*)"Dame los metros cuadrados"
read*,a
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Barn"
write(*,*)"2.- Hectárea"
write(*,*)"3.- Pie cuadrado"
write(*,*)"4.- Pulgada cuadrada"
write(*,*)"5.- Yarda cuadrada"
write(*,*)"6.- Centímetro cuadrado"
read*,opac
!selección del caso para unidad de conversión
select case(opac)
case(1)
ac=a*(10**28)
write(*,*)"Tu conversion de",a,"m2 es",ac,"b"
case(2)
ac=a/(10**4)
write(*,*)"Tu conversion de",a,"m2 es",ac,"ha"
case(3)
ac=a*(9.290304**2)
write(*,*)"Tu conversion de",a,"m2 es",ac,"ft2"
case(4)
ac=a*(6.4516**4)
write(*,*)"Tu conversion de",a,"m2 es",ac,"in2"
case(5)
ac=a*8.361274
write(*,*)"Tu conversion de",a,"m2 es",ac,"yd2"
case(6)
ac=a*(10**4)
write(*,*)"Tu conversion de",a,"m2 es",ac,"cm2"
case default
write(*,*)"Opción no valida"
end select
case(2)
write(*,*)"Dame los Barns"
read*,a
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Metro cuadrado"
write(*,*)"2.- Hectárea"
write(*,*)"3.- Pie cuadrado"
write(*,*)"4.- Pulgada cuadrada"
write(*,*)"5.- Yarda cuadrada"
write(*,*)"6.- Centímetro cuadrado"
read*,opac
!selección del caso para unidad de conversión
select case(opac)
case(1)
ac=a*(10**(-28))
write(*,*)"Tu conversion de",a,"b es",ac,"m2"
case(2)
ac=(a*(10**(-28)))/(10**4)
write(*,*)"Tu conversion de",a,"b es",ac,"ha"
case(3)
ac=(a*(10**(-28)))*(9.290304**2)
write(*,*)"Tu conversion de",a,"b es",ac,"ft2"
case(4)
ac=(a*(10**(-28)))*(6.4516**4)
write(*,*)"Tu conversion de",a,"b es",ac,"in2"
case(5)
ac=(a*(10**(-28)))*8.361274
write(*,*)"Tu conversion de",a,"b es",ac,"yd2"
case(6)
ac=(a*(10**(-28)))*(10**4)
write(*,*)"Tu conversion de",a,"b es",ac,"cm2"
case default
write(*,*)"Opción no valida"
end select
case(3)
write(*,*)"Dame las Hectáreas"
read*,a
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Metro cuadrado"
write(*,*)"2.- Barn"
write(*,*)"3.- Pie cuadrado"
write(*,*)"4.- Pulgada cuadrada"
write(*,*)"5.- Yarda cuadrada"
write(*,*)"6.- Centímetro cuadrado"
read*,opac
!selección del caso para unidad de conversión
select case(opac)
case(1)
ac=a/(10**4)
write(*,*)"Tu conversion de",a,"ha es",ac,"m2"
case(2)
ac=(a/(10**4))*(10**28)
write(*,*)"Tu conversion de",a,"ha es",ac,"b"
case(3)
ac=(a/(10**4))*(9.290304**2)
write(*,*)"Tu conversion de",a,"ha es",ac,"ft2"
case(4)
ac=(a/(10**4))*(6.4516**4)
write(*,*)"Tu conversion de",a,"ha es",ac,"in2"
case(5)
ac=(a/(10**4))*8.361274
write(*,*)"Tu conversion de",a,"ha es",ac,"yd2"
case(6)
ac=(a/(10**4))*(10**4)
write(*,*)"Tu conversion de",a,"ha es",ac,"cm2"
case default
write(*,*)"Opción no valida"
end select
case(4)
write(*,*)"Dame los Pies cuadrados"
read*,a
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Metro cuadrado"
write(*,*)"2.- Barn"
write(*,*)"3.- Hectárea"
write(*,*)"4.- Pulgada cuadrada"
write(*,*)"5.- Yarda cuadrada"
write(*,*)"6.- Centímetro cuadrado"
read*,opac
!selección del caso para unidad de conversión
select case(opac)
case(1)
ac=a/(9.290304**2)
write(*,*)"Tu conversion de",a,"ft2 es",ac,"m2"
case(2)
ac=(a/(9.290304**2))*(10**28)
write(*,*)"Tu conversion de",a,"ft2 es",ac,"b"
case(3)
ac=(a/(9.290304**2))/(10**4)
write(*,*)"Tu conversion de",a,"ft2 es",ac,"ha"
case(4)
ac=(a/(9.290304**2))*(6.4516**4)
write(*,*)"Tu conversion de",a,"ft2 es",ac,"in2"
case(5)
ac=(a/(9.290304**2))*8.361274
write(*,*)"Tu conversion de",a,"ft2 es",ac,"yd2"
case(6)
ac=(a/(9.290304**2))*(10**4)
write(*,*)"Tu conversion de",a,"ft2 es",ac,"cm2"
case default
write(*,*)"Opción no valida"
end select
case(5)
write(*,*)"Dame los Pulgada cuadrada"
read*,a
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Metro cuadrado"
write(*,*)"2.- Barn"
write(*,*)"3.- Hectárea"
write(*,*)"4.- Pie cuadrado"
write(*,*)"5.- Yarda cuadrada"
write(*,*)"6.- Centímetro cuadrado"
read*,opac
!selección del caso para unidad de conversión
select case(opac)
case(1)
ac=a/(6.4516**4)
write(*,*)"Tu conversion de",a,"in2 es",ac,"m2"
case(2)
ac=(a/(6.4516**4))*(10**28)
write(*,*)"Tu conversion de",a,"in2 es",ac,"b"
case(3)
ac=(a/(6.4516**4))/(10**4)
write(*,*)"Tu conversion de",a,"in2 es",ac,"ha"
case(4)
ac=(a/(6.4516**4))*(9.290304**2)
write(*,*)"Tu conversion de",a,"in2 es",ac,"ft2"
case(5)
ac=(a/(6.4516**4))*8.361274
write(*,*)"Tu conversion de",a,"in2 es",ac,"yd2"
case(6)
ac=(a/(6.4516**4))*(10**4)
write(*,*)"Tu conversion de",a,"in2 es",ac,"cm2"
case default
write(*,*)"Opción no valida"
end select
case(6)
write(*,*)"Dame las Yardas cuadradas"
read*,a
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Metro cuadrado"
write(*,*)"2.- Barn"
write(*,*)"3.- Hectárea"
write(*,*)"4.- Pie cuadrado"
write(*,*)"5.- Pulgada cuadrada"
write(*,*)"6.- Centímetro cuadrado"
read*,opac
!selección del caso para unidad de conversión
select case(opac)
case(1)
ac=a/8.361274
write(*,*)"Tu conversion de",a,"yd2 es",ac,"m2"
case(2)
ac=(a/8.361274)*(10**28)
write(*,*)"Tu conversion de",a,"yd2 es",ac,"b"
case(3)
ac=(a/8.361274)/(10**4)
write(*,*)"Tu conversion de",a,"yd2 es",ac,"ha"
case(4)
ac=(a/8.361274)*(9.290304**2)
write(*,*)"Tu conversion de",a,"yd2 es",ac,"ft2"
case(5)
ac=(a/8.361274)*(6.4516**4)
write(*,*)"Tu conversion de",a,"yd2 es",ac,"in2"
case(6)
ac=(a/8.361274)*(10**4)
write(*,*)"Tu conversion de",a,"yd2 es",ac,"cm2"
case default
write(*,*)"Opción no valida"
end select
case(7)
write(*,*)"Dame los centimetros cuadrados"
read*,a
write(*,*)"A que unidad deseas convertir"
write(*,*)"1.- Metros cuadrados"
write(*,*)"2.- Barn"
write(*,*)"3.- Hectárea"
write(*,*)"4.- Pie cuadrado"
write(*,*)"5.- Pulgada cuadrada"
write(*,*)"6.- Yarda cuadrada"
read*,opac
!selección del caso para unidad de conversión
select case(opac)
case(1)
ac=a/(10**4)
write(*,*)"Tu conversion de",a,"cm2 es",ac,"m2"
case(2)
ac=(a/(10**4))*(10**28)
write(*,*)"Tu conversion de",a,"cm2 es",ac,"b"
case(3)
ac=(a/(10**4))/(10**4)
write(*,*)"Tu conversion de",a,"cm2 es",ac,"ha"
case(4)
ac=(a/(10**4))*(9.290304**2)
write(*,*)"Tu conversion de",a,"cm2 es",ac,"ft2"
case(5)
ac=(a/(10**4))*(6.4516**4)
write(*,*)"Tu conversion de",a,"cm2 es",ac,"in2"
case(6)
ac=(a/(10**4))*8.361274
write(*,*)"Tu conversion de",a,"cm2 es",ac,"yd2"
case default
write(*,*)"Opción no valida"
end select
case default
write(*,*)"Opción no valida"
!fin del caso para la conversión de areas
end select
!caso para la conversión de unidades de longitud
case(5)
write(*,*)"Selecciona la unidad en la que vas a meter la distancia o longitud"
write(*,*)"1.- Metro"
write(*,*)"2.- milla"
write(*,*)"3.- pie"
write(*,*)"4.- yarda"
write(*,*)"5.- centimetro"
write(*,*)"6.- kilometro"
write(*,*)"7.- pulgada"
read*,opl
!selección del caso para la conversión de unidades de fuerza
select case(opl)
case(1)
write(*,*)"Dame la longitud en metros"
read*,l
write(*,*)"1.- milla"
write(*,*)"2.- pie"
write(*,*)"3.- yarda"
write(*,*)"4.- centimetro"
write(*,*)"5.- kilometro"
write(*,*)"6.- pulgada"
read*,oplc
!selección del caso para la unidad de conversión
select case(oplc)
case(1)
lc=l*(6.2137*(10**(-4)))
write(*,*)"Tu conversion de",l,"m es",lc,"millas"
case(2)
lc=l*3.2808
write(*,*)"Tu conversion de",l,"m es",lc,"ft"
case(3)
lc=l*1.0936
write(*,*)"Tu conversion de",l,"m es",lc,"yd"
case(4)
lc=l*100
write(*,*)"Tu conversion de",l,"m es",lc,"cm"
case(5)
lc=l/1000
write(*,*)"Tu conversion de",l,"m es",lc,"km"
case(6)
lc=l*39.37
write(*,*)"Tu conversion de",l,"m es",lc,"in"
case default
write(*,*)"Opción no valida"
end select
case(2)
write(*,*)"Dame la longitud en millas"
read*,l
write(*,*)"1.- metro"
write(*,*)"2.- pie"
write(*,*)"3.- yarda"
write(*,*)"4.- centimetro"
write(*,*)"5.- kilometro"
write(*,*)"6.- pulgada"
read*,oplc
!selección del caso para la unidad de conversión
select case(oplc)
case(1)
lc=l*(1.6093*(10**3))
write(*,*)"Tu conversion de",l,"millas es",lc,"m"
case(2)
lc=l*5280
write(*,*)"Tu conversion de",l,"millas es",lc,"ft"
case(3)
lc=l*1760
write(*,*)"Tu conversion de",l,"millas es",lc,"yd"
case(4)
lc=l*(1.6093*(10**5))
write(*,*)"Tu conversion de",l,"millas es",lc,"cm"
case(5)
lc=(l*(1.6093*(10**3)))/1000
write(*,*)"Tu conversion de",l,"millas es",lc,"km"
case(6)
lc=l*(6.336*(10**4))
write(*,*)"Tu conversion de",l,"m es",lc,"in"
case default
write(*,*)"Opción no valida"
end select
case(3)
write(*,*)"Dame la longitud en pies"
read*,l
write(*,*)"1.- metro"
write(*,*)"2.- milla"
write(*,*)"3.- yardas"
write(*,*)"4.- centimetro"
write(*,*)"5.- kilometro"
write(*,*)"6.- pulgadas"
read*,oplc
!selección del caso para la unidad de conversión
select case(oplc)
case(1)
lc=l*0.3048
write(*,*)"Tu conversion de",l,"ft es",lc,"m"
case(2)
lc=l*(1.8939*(10**(-4)))
write(*,*)"Tu conversion de",l,"ft es",lc,"millas"
case(3)
lc=l/3
write(*,*)"Tu conversion de",l,"ft es",lc,"yd"
case(4)
lc=l*30.48
write(*,*)"Tu conversion de",l,"ft es",lc,"cm"
case(5)
lc=(l*0.3048)/1000
write(*,*)"Tu conversion de",l,"ft es",lc,"km"
case(6)
lc=l*12
write(*,*)"Tu conversion de",l,"ft es",lc,"in"
case default
write(*,*)"Opción no valida"
end select
case(4)
write(*,*)"Dame la longitud en yardas"
read*,l
write(*,*)"1.- metro cuadrado"
write(*,*)"2.- milla"
write(*,*)"3.- pie"
write(*,*)"4.- centimetro"
write(*,*)"5.- kilometro"
write(*,*)"6.- pulgada"
read*,oplc
!selección del caso para la unidad de conversión
select case(oplc)
case(1)
lc=l*0.9144
write(*,*)"Tu conversion de",l,"yd es",lc,"m"
case(2)
lc=l*(5.6818*(10**(-4)))
write(*,*)"Tu conversion de",l,"yd es",lc,"millas"
case(3)
lc=l*3
write(*,*)"Tu conversion de",l,"yd es",lc,"ft"
case(4)
lc=l*91.44
write(*,*)"Tu conversion de",l,"yd es",lc,"cm"
case(5)
lc=(l*0.9144)/1000
write(*,*)"Tu conversion de",l,"yd es",lc,"km"
case(6)
lc=l*36
write(*,*)"Tu conversion de",l,"yd es",lc,"in"
case default
write(*,*)"Opción no valida"
end select
case(5)
write(*,*)"Dame la longitud en centimetros"
read*,l
write(*,*)"1.- metro"
write(*,*)"2.- milla"
write(*,*)"3.- pie"
write(*,*)"4.- yarda"
write(*,*)"5.- kilometro"
write(*,*)"6.- pulgada"
read*,oplc
!selección del caso para la unidad de conversión
select case(oplc)
case(1)
lc=l/100
write(*,*)"Tu conversion de",l,"cm es",lc,"m"
case(2)
lc=l*(6.2137*(10**(-6)))
write(*,*)"Tu conversion de",l,"cm es",lc,"millas"
case(3)
lc=l*0.032808
write(*,*)"Tu conversion de",l,"cm es",lc,"ft"
case(4)
lc=l*0.010936
write(*,*)"Tu conversion de",l,"cm es",lc,"yd"
case(5)
lc=(l/100)/1000
write(*,*)"Tu conversion de",l,"cm es",lc,"km"
case(6)
lc=l*0.3937
write(*,*)"Tu conversion de",l,"cm es",lc,"in"
case default
write(*,*)"Opción no valida"
end select
case(6)
write(*,*)"Dame la longitud en kilometros"
read*,l
write(*,*)"1.- metro"
write(*,*)"2.- milla"
write(*,*)"3.- pie"
write(*,*)"4.- yarda"
write(*,*)"5.- centimetro"
write(*,*)"6.- pulgada"
read*,oplc
!selección del caso para la unidad de conversión
select case(oplc)
case(1)
lc=l*1000
write(*,*)"Tu conversion de",l,"km es",lc,"m"
case(2)
lc=(l*1000)*(6.2137*(10**(-4)))
write(*,*)"Tu conversion de",l,"km es",lc,"millas"
case(3)
lc=(l*1000)*3.2808
write(*,*)"Tu conversion de",l,"km es",lc,"ft"
case(4)
lc=(l*1000)*1.0936
write(*,*)"Tu conversion de",l,"km es",lc,"yd"
case(5)
lc=l*(10**6)
write(*,*)"Tu conversion de",l,"km es",lc,"cm"
case(6)
lc=l*1000*39.37
write(*,*)"Tu conversion de",l,"km es",lc,"in"
case default
write(*,*)"Opción no valida"
end select
case(7)
write(*,*)"Dame la longitud en pulgadas"
read*,l
write(*,*)"1.- metro"
write(*,*)"2.- milla"
write(*,*)"3.- pie"
write(*,*)"4.- yarda"
write(*,*)"5.- centimetro"
write(*,*)"6.- kilometro"
read*,oplc
!selección del caso para la unidad de conversión
select case(oplc)
case(1)
lc=l*0.0254
write(*,*)"Tu conversion de",l,"in es",lc,"m"
case(2)
lc=l*(1.5783*(10**(-5)))
write(*,*)"Tu conversion de",l,"in es",lc,"millas"
case(3)
lc=l*0.083333
write(*,*)"Tu conversion de",l,"in es",lc,"ft"
case(4)
lc=l*0.027778
write(*,*)"Tu conversion de",l,"in es",lc,"yd"
case(5)
lc=l*2.54
write(*,*)"Tu conversion de",l,"in es",lc,"cm"
case(6)
lc=(l*0.0254)/1000
write(*,*)"Tu conversion de",l,"in es",lc,"km"
case default
write(*,*)"Opción no valida"
end select
!fin del caso para la conversión de longitudes
end select
case default
write(*,*)"Opcion no valida"
!fin de la seleccion de conversiones0
end select
pause
end program proyecto



menu de programas fortran 90/95

PRINT*,"1) PROGRAMA SUMA DE 4 TERMINOS"
PRINT*,"2) PROGRAMA COSENO"
PRINT*,"3) PROGRAMA TRIANGULAR"
PRINT*,"4) PROGRAMA EXPONENCIAL"
PRINT*,"5) PROGRAMA VOLUMEN DE UNA ESFERA"
PRINT*,"6) PROGRAMA QUE CALCULE PI"
PRINT*,"7) PROGRAMA QUE CALCULA LA SUMA DE LOS TERMINOS DE 1 A 500"
PRINT*,"8) PROGRAMA DE SUMA DE MATRICES"
PRINT*,"9) PROGRAMA DE RESTA DE MATRICES"
PRINT*,"10) PROGRAMA QUE CALCULA LA CONVERSION DE GRADOS °C A °K "
PRINT*," "
PRINT*,"¿CUAL ES TU OPCION?"
PRINT*," "
READ*,OPCION

PRO: SELECT CASE (OPCION)
CASE (1)
PRINT*,"SE EJECUTARA EL PROGRAMA PARA SUMAR 4 TERMINOS"
PRINT*,"INTRODUCE 4 TERMINOS"
READ*,A,B,C,D
PRINT*,"LA SUMA ES:",SUMA4(A,B,C,D)

CASE (2)
PRINT*,"SE EJECUTARA EL PROGRAMA PARA CALCULAR COSENO"
PRINT*,"INTRODUCE VALOR DE TETA:"
READ*,A
PRINT*,"INTRODUCE NUMERO DE TERMINOS DE LA SERIE:"
READ*,B
PRINT*,"EL COSENO DE TETA ES:",COSENO(A,B)

CASE(3)
PRINT*,"SE EJECUTARA EL PROGRAMA PARA DETERMINAR NUMEROS TRIANGULARES"
PRINT*,"INTRODUCE EL NUMERO:"
READ*,A
CALL TRIANGULAR(A,OPCION1)
IF (OPCION1==1) THEN
PRINT*,"NO ES TRIANGULAR"
ELSE
PRINT*,"ES TRIANGULAR"
END IF
!
!
CASE(4)

PRINT*,"SE EJECUTARA EL PROGRMA PARA CALCULAR EXPONENCIAL"
PRINT*,"INTRODUCE EL VALOR DE X:"
!
PRINT*,"SE EJECUTARA EL PROGRMA PARA CALCULAR EXPONENCIAL"
PRINT*,"INTRODUCE EL VALOR DE X:"
READ*,A
PRINT*,"EL EXPONENCIAL ES:",EXPONENCIAL(A)


CASE(5)
PRINT*,"SE EJECUTARA QUE CALCULA EL VOLUMEN DE UNA ESFERA"
PRINT*,"INTRODUCE R"
READ*,R
CALL VOLUMEN(R)


CASE (6)
PRINT*,"SE EJECUTARA EL PROGRAMA PARA CALCULAR PI"
PRINT*,"EL VALOR DE PI ES:",PI()

CASE (7)
PRINT*,"SE EJECUTARA EL PROGRAMA PARA CALCULAR LA SUMA DE LOS NUMEROS DE 1 A 500"
PRINT*,"LA SUMA DE LOS TERMINOS ES:",SECUENCIA()

CASE(8)
PRINT*, "Introduce el No. total de filas de la matriz: "
READ*,AA
PRINT*," "
PRINT*, "Introduce el No. total de columnas de la matriz: "
READ*, BB
ALLOCATE (A1(AA,BB),B1(AA,BB),MATC(AA,BB))
PRINT*," "
DO K=1,AA,1
PRINT*, "Introduce los valores del renglon ",k,"de la matriz A: "
READ*, (A1(K,J),J=1,BB,1)
END DO
PRINT*," "
DO K=1,AA,1
PRINT*,"Introduce los valores del renglon ",k,"de la matriz B: "
READ*,(B1(K,J),J=1,BB,1)
END DO
CALL SUMAMAT(AA,BB,A1,B1)

CASE (9)
PRINT*, "Introduce el No. total de filas de la matriz: "
READ*,AA
PRINT*," "
PRINT*, "Introduce el No. total de columnas de la matriz: "
READ*, BB
ALLOCATE (A1(AA,BB),B1(AA,BB),MATC(AA,BB))
PRINT*," "
DO K=1,AA,1
PRINT*, "Introduce los valores del renglon ",k,"de la matriz A: "
READ*, (A1(K,J),J=1,BB,1)
END DO
PRINT*," "
DO K=1,AA,1
PRINT*,"Introduce los valores del renglon ",k,"de la matriz B: "
READ*,(B1(K,J),J=1,BB,1)
END DO
CALL RESTAMAT(AA,BB,A1,B1)

CASE (10)
PRINT*,"INTRODUCE TEMPERATURA EN GRADOS CENTIGRADOS:"
READ*,A
PRINT*,"LA CONVERSION ES:",CONVER(A)
END SELECT PRO
END PROGRAM MASTER

REAL FUNCTION COSENO(TETA,NUM)
IMPLICIT NONE
REAL,INTENT (IN)::TETA,NUM
INTEGER::FACTORIAL,J,I,PARCIAL,SIGNO=-1
REAL::RESPARCIAL=0,NUM2
IF(NUM>1)THEN
NUM2=NUM*2-2
END IF
DO I=2,NUM2,2
PARCIAL=TETA**I
FACTORIAL=1
DO J=1,I,1
FACTORIAL=FACTORIAL*J
END DO
RESPARCIAL=RESPARCIAL+(REAL(PARCIAL)/REAL(FACTORIAL)*SIGNO)
SIGNO=-SIGNO
END DO
COSENO=1+RESPARCIAL
END FUNCTION COSENO

REAL FUNCTION EXPONENCIAL(X)
IMPLICIT NONE
REAL, INTENT(IN)::X
INTEGER::I,J
REAL::XPARCIAL=0,SUMA=1,FACTORIAL=1


DO I=1,3,1
XPARCIAL=(REAL(X)**I)
PRINT*,"XPARCIAL: ",XPARCIAL
PRINT*,"----------------------------"
DO J=I,1,-1
FACTORIAL=(FACTORIAL*J)
END DO
PRINT*,"FACTORIAL: ",FACTORIAL
PRINT*,"----------------------------"

SUMA=SUMA+XPARCIAL/FACTORIAL
FACTORIAL=1
END DO
EXPONENCIAL=SUMA
END FUNCTION EXPONENCIAL

SUBROUTINE TRIANGULAR(NUM,SALI)
IMPLICIT NONE
REAL,INTENT(IN)::NUM
INTEGER, INTENT(OUT)::SALI
INTEGER::CONTADOR,OPCION=1
REAL::M

DO
OPCION=1
IF(NUM>0) EXIT
END DO
CONTADOR=1

DO
M=(CONTADOR*(CONTADOR+1))/2.0
IF(NUM==M) THEN
OPCION=2
END IF
IF(CONTADOR>=NUM) EXIT
CONTADOR=CONTADOR+1
END DO
SALI=OPCION

END SUBROUTINE TRIANGULAR

REAL FUNCTION SUMA4 (X,Y,Z,W)
IMPLICIT NONE
REAL, INTENT (IN)::X,Y,Z,W
SUMA4= X+Y+Z+W
END FUNCTION SUMA4

SUBROUTINE VOLUMEN(R)
IMPLICIT NONE
REAL:: VOL_ESFERA,R
REAL,PARAMETER:: PI=3.1415927
VOL_ESFERA=(4*PI*R**3)/3
PRINT*,VOL_ESFERA
END SUBROUTINE VOLUMEN



REAL FUNCTION PI()
IMPLICIT NONE
REAL::PIPARCIAL=0,PR
INTEGER::SIGNO=1,I=1
DO
PIPARCIAL=PIPARCIAL+1.0/I*SIGNO
SIGNO=-SIGNO
I=I+2
IF(I>99)EXIT
END DO
PI=4*PIPARCIAL
END FUNCTION PI

REAL FUNCTION SECUENCIA()
IMPLICIT NONE
INTEGER::I
REAL::SUMA

SUMA=0
DO I=1,500,1
SUMA=SUMA+I
PRINT*,"SUMA: ",SUMA
PRINT*,"-----------------------------"
END DO
SECUENCIA=SUMA
END FUNCTION SECUENCIA


SUBROUTINE SUMAMAT(M,N,Mat1,mat2)
integer,INTENT(IN)::M,N
REAL,DIMENSION(m,n),INTENT(IN)::mat1,mat2
REAL,DIMENSION(m,n)::matr
DO K=1,M,1
DO J=1,N,1
matr(K,J)=mat1(K,J)+mat2(K,J)
END DO
END DO
DO K=1,M,1
PRINT*," "
PRINT*,(MATR(K,J),J=1,N,1)
PRINT*," "
END DO
END SUBROUTINE

SUBROUTINE RESTAMAT(M,N,Mat1,mat2)
integer,INTENT(IN)::M,N
REAL,DIMENSION(m,n),INTENT(IN)::mat1,mat2
REAL,DIMENSION(m,n)::matr
DO K=1,M,1
DO J=1,N,1
matr(K,J)=mat1(K,J)-mat2(K,J)
END DO
END DO
DO K=1,M,1
PRINT*," "
PRINT*,(MATR(K,J),J=1,N,1)
PRINT*," "
END DO
END SUBROUTINE RESTAMAT

REAL FUNCTION CONVER(X)
REAL,INTENT(IN)::X
REAL,PARAMETER::Y=273.15
CONVER=X+Y
END FUNCTION CONVER
PROYECTO 2
CALCULADORA DE MATRICES Y VECTORES

program vectores y mattrices
IMPLICIT NONE
INTEGER,ALLOCATABLE,DIMENSION(:) ::vector1,vector2,suma,resta,multiplicacion
INTEGER,ALLOCATABLE,DIMENSION (:,:)::mat1,mat2,sumam,restam,multiplicacionm
INTEGER :: ERROR,i,j,op,op2,op3
integer::n,m
REAL mult
PRINT*,"calculadora de vectores y matrices"
PRINT*,"presiona 1 para trabajar con vectores y 2 para trabajr con matrices"
READ*,op
select case (op)
case (1)

write(*,*)"Dame el tamaño de los vectores"
read*,n
allocate(vector1( n ),vector2( n ),suma( n ),resta( n ),multiplicacion( n ),STAT=error)
IF (error /= 0) THEN
WRITE(*,*) 'NO SUFICIENTE ESPACIO MEMORIA'
STOP
END IF
!LECTURA DE VECTORES
PRINT*,"DAME LOS VALORES DE EL VECTOR"
DO i=1,n
PRINT*, 'ELEMENTO',i,' DE VECTOR 1'
READ(*,*) vector1(i)
END DO

PRINT*,"DAME LOS VALORES DEL VECTOR 2"
DO i=1,n
PRINT*, 'ELEMENTO',i,' DE VECTOR 2'
READ(*,*) vector2(i)
END DO

PRINT*,"QUE OPERACION DECEAS HACER???"
PRINT*,"presiona 1 para sumar vectores"
PRINT*,"presiona 2 para restar (se resta el segndo al primero)"
PRINT*,"presiona 3 para multiplicar (producto punto)"
READ*,op2
select case (op2)
case (1)

!realizalas operaciones entre vectores
DO i=1,n

suma(i)=vector1(i)+vector2(i)
END DO


WRITE(*,*) 'VECTORES SUMADOS'
PRINT*,suma

case (2)
DO i=1,n

resta(i)=vector1(i)-vector2(i)
END DO


WRITE(*,*) 'VECTORES RESTADOS'
PRINT*,resta

case (3)



multiplicacion(i)=DOT_PRODUCT(vector1,vector2)


WRITE(*,*) 'VECTORES MULTIPLICADOS'
PRINT*,multiplicacion


deallocate(vector1,vector2,suma,resta,multiplicacion,STAT=error)
IF (error /= 0) THEN
WRITE(*,*) 'ERROR AL LIBERAR LA MEMORIA'
STOP
END IF

case default
PRINT*,"ERROR... ESTE VALOR NO ESTA EN EL MENU"
end select




!MATRICES



case (2)





write(*,*)"DAME EL TAMAÑO DE LAS MATRICES RECUERDA QUE SERAN DEL MISMO TAMAÑO"
PRINT*,"tamaño de n"
read*,n
PRINT*,"tamaño de m"
READ*,m



allocate(mat1( n,m ),mat2( n,m ),sumam( n,m ),restam( n,m ),multiplicacionm( n,m ),STAT=error)
IF (error /= 0) THEN
WRITE(*,*) 'NO SUFICIENTE ESPACIO MEMORIA'
STOP
END IF

!LECTURA DE MATRICES
PRINT*,"DAME LOS VALORES DE LA MATRIZ 1"
DO i=1,n
do J=1,m

PRINT*, 'ELEMENTO',i,j,' DE MATRIZ 1 '
READ(*,*) mat1(i,j)

end do
END DO

PRINT*,"DAME LOS VALORES DE LA MATRIZ 2"
DO i=1,n
do j=1,m

PRINT*, 'ELEMENTO',i,j,' DE MATRIZ 2'
READ(*,*) mat2(i,j)
end do
END DO





PRINT*,"QUE OPERACION DECEAS HACER???"
PRINT*,"presiona 1 para sumar vectores"
PRINT*,"presiona 2 para restar (se resta el segndo al primero)"
PRINT*,"presiona 3 para multiplicar "
READ*,op3
select case (op3)




!realizalas operaciones entre matrices
case (1)
DO i=1,n
do j=1,m

sumam(i,j)=mat1(i,j)+mat2(i,j)
END DO
end do


WRITE(*,*) 'MATRICES SUMADAS'
PRINT*,SUMAM

case (2)

DO i=1,n
do j=1,m

RESTAM(i,j)=mat1(i,j)-mat2(i,j)
END DO
end do


WRITE(*,*) 'MATRICES RESTADAS'
PRINT*,RESTAM

case (3)


multiplicacionm=matmul(mat1,mat2)



WRITE(*,*) 'MATRICES MULTIPLICADAS'
PRINT*,multiplicacionm


deallocate(mat1,mat2,sumam,restam,multiplicacionm,STAT=error)
IF (error /= 0) THEN
WRITE(*,*) 'ERROR AL LIBERAR LA MEMORIA'
STOP
END IF
case default
PRINT*,'NO EXISTE ESTA OPCION DEL MENU -.-"'
end select
case default
PRINT*,"SOLO HAY DOS OPCIONES ESTA NO EXISTE"
end select
end program vectores y mattrices

miércoles, 2 de junio de 2010

calculadora de vectores.....fortran 90

program vectores
IMPLICIT NONE
INTEGER,ALLOCATABLE,DIMENSION(:) :: vector1,vector2,suma,resta,multiplicacion
INTEGER :: ERROR,i
REAL::n
write(*,*)"Dame el tamaño de los vectores"
read*,n
allocate(vector1( n ),vector2( n ),suma( n ),resta( n ),multiplicacion( n ),STAT=error)
IF (error /= 0) THEN
WRITE(*,*) 'NO SUFICIENTE ESPACIO MEMORIA'
STOP
END IF
!LECTURA DE VECTORES
PRINT*,"DAME LOS VALORES DE EL VECTOR"
DO i=1,n
PRINT*, 'ELEMENTO',i,' DE VECTOR A'
READ(*,*) vector1(i)
END DO

PRINT*,"AHORA EL OTRO VECTOR"
DO i=1,n
PRINT*, 'ELEMENTO',i,' DE MVECTOR B'
READ(*,*) vector2(i)
END DO
!realizalas operaciones entre vectores
DO i=1,n

suma(i)=vector1(i)+vector2(i)
END DO


WRITE(*,*) 'VECTORes sumados'
PRINT*,suma
!
!
DO i=1,n

resta(i)=vector1(i)-vector2(i)
END DO


WRITE(*,*) 'VECTORes resta'
PRINT*,resta
!
DO i=1,n

multiplicacion(i)=vector1(i)*vector2(i)
END DO


WRITE(*,*) 'VECTORes multiplicados'
PRINT*,multiplicacion

!
deallocate(vector1,vector2,suma,resta,multiplicacion,STAT=error)
IF (error /= 0) THEN
WRITE(*,*) 'ERROR AL LIBERAR LA MEMORIA'
STOP
END IF
end program vectores

gauss jordan .....

! Last change: AC 2 Jun 2010 10:04 pm
!programa que resuelve ecuaciones lineales por el metodo de gauss
program gauss
implicit none
REAL,DIMENSION(:,:),ALLOCATABLE::M
REAL,DIMENSION(:),ALLOCATABLE::D,X
REAL::DET,N
INTEGER::i,k,j,L,g
PRINT*,'Este programa resuelve ecuaciones simltaneas'
PRINT*,'por el metodo de Gauss'
!
!
PRINT*,'DE CUANTAS ECUCIONES CONSTA TU SISTEMA'
READ*,n
!
PRINT*,'M representa lamatriz del sistema'
PRINT*,'D representa a lamatriz de terminos independientes'
!
ALLOCATE (M(N,N),D(N),X(N))
DO i=1,N,1
PRINT*,'Intoroduce los elementos de la matriz del sistema, fila',i
do k=1,N,1
PRINT*,'Introduce el elemento c(',i,',',k,')='
READ*,M(i,k)
END DO
!
PRINT *,'Intoroduce los elementos de la matriz terminos independientes'
READ*,D(i)
END DO
DET=1
DO i=1,N-1,1
DET=DET*M(i,i)
IF (DET==0)then
PRINT*,'no puede resolverse por eliminacion de gauss'
else
DO j=1,N-1,1
DO k=i+1,N,1
M(j,k)=M(j,k)-M(j,i)*M(i,j)/M(i,i)
END DO
g=D(j)-M(j,i)*D(i)/M(i,i)
END DO
END IF
END DO
DET=DET*M(N,N)
IF(DET==0)then
PRINT*,'no puede resolverse por eliminacion de gauss'
else
X(N)=D(N)/M(N,N)
DO L=N-1,1,-1
X(L)=D(L)
DO i=L+1,N,1
X(L)=X(L)/M(L,L)
END DO
END DO
PRINT*, 'la solucion de tu sistema es:'
DO k=1,N,1
PRINT*,'X(",K,")=',X(k)
END DO
END IF
end program gauss

fortran subritinas gauss con pivoteo...

! Last change: AC 2 Jun 2010 10:06 pm
PROGRAM GAUSS
!========================================
!RESOLUCION DE MATRICES A TRAVES DE ¦¦
!METODO DE GAUSS Y PIVOTEO ¦¦
!========================================
IMPLICIT NONE
INTEGER:: I,J,K,N
REAL:: FACTOR
REAL,ALLOCATABLE :: MAT(:,:),RESULTADOS(:)
WRITE(*,*)"PROGRAMA DE RESOLUCION DE ECUACIONES"
WRITE(*,*)" A PARTIR DEL METODO DE GAUSS "
WRITE(*,*)""
WRITE(*,*)""
WRITE(*,*)"INTRODUCE EL NUMERO INCOGNITAS EN LAS ECUACIONES: "
READ(*,*)N
ALLOCATE (MAT(N,N+1),RESULTADOS(N))
DO I=1,N,1
DO J=1,N+1,1
WRITE(*,*)"INTRODUCE EL ELEMENTO (",I,",",J,"): "
READ(*,*)MAT(I,J)
END DO
END DO
DO K=1,N-1,1
DO I=K,N-1,1
IF (K==I) THEN
CALL PIVOTE(MAT,N,K)
ENDIF
FACTOR=MAT(I+1,K)/MAT(K,K)
DO J=1,N+1,1
MAT(I+1,J)=MAT(I+1,J)-(FACTOR*MAT(K,J))
ENDDO
ENDDO
ENDDO
WRITE(*,*)"LA MATRIZ RESULTANTE DESPUES DE LAS OPERACIONES ES LA SIGUIENTE:"
WRITE(*,*)""
DO I=1,N,1
DO J=1,N+1,1
WRITE(*,*)"(",I,",",J,")",MAT(I,J)
ENDDO
ENDDO
CALL SOLUCION(MAT,N,RESULTADOS)
WRITE(*,*)"LOS RESULTADOS PARA LOS VALORES DE X SON LOS SIGUIENTES: "
DO I=1,N,1
WRITE(*,*)" X(",I,"):",RESULTADOS(I)
ENDDO
ENDPROGRAM

SUBROUTINE PIVOTE(MAT,N,I)
!===================================================
!SUBRUTINA QUE NOS AYUDA A DETERMINAR EL ELEMENTO ¦¦
!MAYOR A SER CONSIDERADO EL PIVOTE DE LOS CALCULOS¦¦
!Y LO REEMPLAZA EN EL ORDEN DE LOS MISMOS ¦¦
!===================================================
IMPLICIT NONE
INTEGER::I,N,K,INDICE,BAND
REAL::TEMP
REAL,DIMENSION(N,N+1)::MAT
BAND=0
INDICE=I
DO K=I+1,N,1
IF (ABS(MAT(INDICE,I)) INDICE=K
BAND=1
ENDIF
ENDDO
IF (BAND/=0) THEN
DO K=I,N+1,1
TEMP=MAT(INDICE,K)
MAT(INDICE,K)=MAT(I,K)
MAT(I,K)=TEMP
ENDDO
ENDIF
RETURN
ENDSUBROUTINE
SUBROUTINE SOLUCION(MAT,N,RESULTADOS)
IMPLICIT NONE
INTEGER:: I,J,N
REAL:: SUMA
REAL,DIMENSION(N)::RESULTADOS
REAL,DIMENSION(N,N+1)::MAT
SUMA=0
RESULTADOS(N)=MAT(N,N+1)/MAT(N,N)
DO I=N-1,1,-1
DO J=I+1,N,1
SUMA=SUMA+(MAT(I,J)*RESULTADOS(J))
ENDDO
RESULTADOS(I)=(MAT(I,N+1)-SUMA)/MAT(I,I)
ENDDO
RETURN
ENDSUBROUTINE