1. PROGRAM ASDASD
2. IMPLICIT NONE
3.  
4. REAL(8), ALLOCATABLE,DIMENSION(:,:)::Matriz
5. INTEGER ORDEN
6.  
7. ORDEN=3
8. ALLOCATE(Matriz(ORDEN,ORDEN))
9. Matriz(1,1)=2.0; Matriz(1,2)=0.0; Matriz(1,3)=0.0
10. Matriz(2,1)=1.0; Matriz(2,2)=1.5; Matriz(2,3)=0.0
11. Matriz(3,1)=0.0; Matriz(3,2)=-3.0; Matriz(3,3)=0.5
12. CALL INVERSA(Matriz)
13.  
14.  
15. CONTAINS
16.  
17. SUBROUTINE ImprimirMat(M)
18.  
19. REAL(8), DIMENSION(:,:), INTENT(IN)::M
20. INTEGER columna,fila,i,j
21.  
22. fila=SIZE(M,DIM=1)
23. columna=SIZE(M,DIM=2)
24. DO i=1, fila
25.    DO j=1, columna
26.       write(*,'(F16.5,X)',ADVANCE='NO')M(i,j)
27.    END DO
28.    write(*,*)
29. END DO
30.  
31. END SUBROUTINE
32.  
33. SUBROUTINE CrearMA(M,Ind,Mamp)
34.  
35. REAL(8), DIMENSION(:,:), INTENT(IN)::M,Ind
36. Real(8), ALLOCATABLE, DIMENSION(:,:)::Mamp
37. INTEGER orden1,orden2,columna,fila
38.  
39. orden1=SIZE(M,DIM=1)
40. orden2=SIZE(Ind,DIM=2)
41. ALLOCATE(Mamp(orden1,orden1+orden2))
42. DO fila=1, orden1
43.    DO columna=1, orden1
44.       Mamp(fila,columna)=M(fila,columna)
45.    END DO
46.    DO columna=1, orden2
47.       Mamp(fila,columna+orden1)=Ind(fila,columna)
48.    END DO
49. END DO
50.  
51. END SUBROUTINE
52.  
53. SUBROUTINE GaussJordanINV(M,Ind)
54.  
55. REAL(8), DIMENSION(:,:), INTENT(IN)::M,Ind
56. Real(8), ALLOCATABLE, DIMENSION(:,:)::Mamp
57. INTEGER orden,c,fila
58.  
59. orden=SIZE(M,DIM=1)
60. CALL CrearMA(M,Ind,Mamp)
61. write(*,*) 'la matriz ampliada es'
62. CALL ImprimirMat(Mamp)
63.   DO c=1, orden
64.     DO fila=1, c-1
65.        Mamp(fila,c+1:)=Mamp(fila,c+1:)-Mamp(c,c+1:)*Mamp(fila,c)/Mamp(c,c)
66.        Mamp(fila,c)=0.0
67.     END DO
68.     DO fila=c+1, orden
69.        Mamp(fila,c+1:)=Mamp(fila,c+1:)-Mamp(c,c+1:)*Mamp(fila,c)/Mamp(c,c)
70.        Mamp(fila,c)=0.0
71.     END DO
72.   END DO
73.   DO c=1, orden
74.     Mamp(c,1:)=Mamp(c,1:)/Mamp(c,c)
75.   END DO
76. write(*,*) 'la matriz despues de GaussJordan es :'
77. CALL ImprimirMat(Mamp)
78. DEALLOCATE(Mamp)
79.  
80. END SUBROUTINE
81.  
82. SUBROUTINE CrearMatID(orden,M)
83.  
84. REAL(8),ALLOCATABLE, DIMENSION(:,:)::M
85. INTEGER orden,i
86.  
87. ALLOCATE(M(orden,orden))
88. M=0.0
89. DO i=1,orden
90.   M(i,i)=1.0
91. END DO
92.  
93. END SUBROUTINE
94.  
95. SUBROUTINE Inversa(M)
96.  
97. REAL(8),DIMENSION(:,:), INTENT(IN)::M
98. REAL(8),ALLOCATABLE, DIMENSION(:,:)::MID
99. INTEGER orden
100.  
101. orden=SIZE(M,DIM=1)
102. CALL CrearMatID(orden,MID)
103. CALL GaussJordanINV(M,MID)
104. DEALLOCATE(MID)
105.  
106. END SUBROUTINE
107.  
108. END PROGRAM
109.