IQI ESIQIE

lunes, 7 de junio de 2010

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

viernes, 14 de mayo de 2010

programa temperaturas.....

PROGRAM temperaturas
! Lee una serie de temperaturas de un archivo y
! calcula el valor medio
IMPLICIT NONE
CHARACTER (LEN=20):: archivo,archivo2
INTEGER:: cuenta, error_de_apertura, error_de_lectura, error_de_escritura
REAL:: temperatura, suma, media
! Abrir archivo como unidad 15
WRITE( *, *)"Dame nombre del archivo para abrir:"
READ (*, *) archivo
OPEN(15, FILE=archivo, STATUS="OLD", ACTION="READ",IOSTAT= error_de_apertura)
IF (error_de_apertura > 0) STOP ' error al abrir el archivo '
WRITE( *, *)"Dame el nombre del archivo donde deseas guardar:"
READ (*, *) archivo2
OPEN(20,FILE=archivo2,STATUS="UNKNOWN",ACTION="WRITE",IOSTAT=error_de_apertura)
IF (error_de_apertura>0) STOP 'archivo no creado'
100 FORMAT (1X, F4.1)
cuenta=0
suma=0
DO
READ (15, 100, IOSTAT = error_de_lectura) temperatura
IF (error_de_lectura >0 ) THEN
WRITE(*,*) "error de lectura"
EXIT
ELSE IF (error_de_lectura <0 ) THEN !WRITE(*,*) "fin del archivo" EXIT ELSE suma = suma + temperatura cuenta = cuenta + 1 PRINT*,temperatura WRITE(20,*,IOSTAT=error_de_escritura)temperatura IF (error_de_escritura>0)STOP 'error de escritura'
!PRINT*,suma
!PRINT*,cuenta
ENDIF
END DO
! Calcular temperatura media
media = suma/ REAL(cuenta)
PRINT*
WRITE (*, *) " temperatura media: "
WRITE (*, *) media

WRITE(20,*,IOSTAT=error_de_escritura)
IF (error_de_escritura>0)STOP 'error de escritura'
WRITE(20,*,IOSTAT=error_de_escritura)"temperatura media:",media
IF (error_de_escritura>0)STOP 'error de escritura'
CLOSE (15)
CLOSE (20)
END PROGRAM temperaturas