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