Problemas de programación con computadora FORTRAN95

! Resolver ecuaciones cuadráticas de una variable.

programa principal

implícito ninguno

real(kind=8)::a,b,c

entero :: miresultado

entero,externo ::Ecuación cuadrática

escribir(*,*)

escribir(*,*) "%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"

!x2-7x+12=0

a=1

b=-7

c=12

myresult=EcuaciónCuadrática(a,b,c)

escribir(*,*)

escribir(* ,*) " %%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"

!Raíz de x2-10x+25=0

a =1

b=-10

c=25

miresultado =Ecuación cuadrática(a,b,c)

escribir(*,*)

escribir(*,*) " %%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"

! Ingrese cualquier coeficiente usted mismo

write(*,*) "Resuelva la ecuación ingresando cualquier coeficiente usted mismo"

write(*,*) "( 1) Ingrese el coeficiente a de la ecuación cuadrática e ingrese"

read(*,*) a

write(*,*) "(2) Ingrese el coeficiente b de la ecuación cuadrática e ingrese"

read( *,*) b

write(*,*) "(3) Ingrese el coeficiente c de la ecuación cuadrática y entrar"

leer(*,*) c

! Llamar subrutina

myresult=QuadraticEquation(a,b,c)

detener

pausa

finalizar programa principal

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! Subrutina

Función entera CuadráticaEcuación(a,b,c)

implícita ninguna

real(kind=8)::a,b, c, delta

real(tipo=8)::x1,x2

! Cuando a==0, simplifica una vez

if(a==0) then

if(b==0) then ! p> si(c==0) entonces! Cuando c==0, si hay alguna solución con números reales, devuelve 1

write(*,*) "La ecuación es 0=0"

write(*,*) "Hay innumerables soluciones con números reales, cualquier número real servirá".

QuadraticEquation=1

devolver

más ! Cuando c/=0, no hay solución.

Devuelve 0

write(*,"(a,f6.2,a)") "La ecuación es: ",c,"=0"

write(*,* ) "La ecuación real no se cumple y no tiene solución real."

QuadraticEququality=1

return

else !

QuadraticEquation =0

regresar

finalizar si

¡si no! Cuando b/=0, la ecuación tiene solución

write(*,"(a,f6.2,a,f6.2,a)") "La ecuación es:",b, " * x+",c,"=0"

write(*,*) " Esta ecuación tiene una solución única: x=",c/b

QuadraticEquation=1

regresar

terminar si

si no

! Cuando a/=0, es una ecuación cuadrática

write(*,"(a,f6.2,a,f6.2,a,f6.2,a,f6.2,a) ") " La ecuación cuadrática es: ",a, "*x^2+",b, "*x+",c,"=0"

! Encuentra delta

delta=b*b-4.0*a*c

if(delta==0) entonces! Cuando delta == 0, existe una solución única -b/a/2.0. Retornar 1

write(*,*) " Una ecuación cuadrática con una solución única (o dos soluciones idénticas): X=",-b/a/2.0

QuadraticEquation =1

devolver

si no (delta<0) entonces! Cuando delta <0, no existe una solución práctica. Devuelve 0

write(*,*) "La ecuación cuadrática no tiene solución real"

QuadraticEquation=0

devuelve

else ! Cuando delta>0, hay dos soluciones reales. Devuelve 1.

delta=sqrt(delta)

x1=(-b-delta)/a/2.0

x2=(-b+delta) /a/2.0

write(*,*) " QuadraticEquation tiene dos soluciones reales: "

write(*,*) "x1=",x1

escribir(*,*) "x2=",x2

QuadraticEquation=1

devolver

finalizar si

finalizar si

retorno

función final ecuación cuadrática

! La subrutina termina.