||کد فرترن معکوس ماتریس|کد فرترن ماتریس معکوس|معکوس یک ماتریس در فرترن|کد فرترن وارون یک ماتریس|وارون ماتریس|محاسبه وارون ماترس|محاسبه معکوس ماتریس
---------------------------------------------------------------------------------------------------------------------------------------------
کد فرترن محاسبه معکوس یک ماتریس...این برنامه اول n رو میگیره و ماتریس n در n رو تشکیل میده بعد خط به خط ماتریس رو از کاربر میگیره و شروع به محاسبه میکنه و معکوسش رو نشون میده.این کد یک سابروتین داره که کارش محاسبه دترمینان برای بدست آوردن ماتریس همسازه ها هستش.اگر دترمینان ماتریس 0 باشه ماتریس معکوس پذیر نیست و یک پیامی و نشون میده.
----------------------------------------------------------------------------------------------------------------------------------------
PROGRAM matrix_inverse
1. IMPLICIT NONE
2. INTEGER::n,i,j,k,p,i1,j1,i2,j2,i3
3. REAL::s,detr,deta
4. REAL,ALLOCATABLE::a(:,:),b(:,:),c(:,:),f(:),g(:,:)
5. PRINT*
6. PRINT*," _ _ "
7. PRINT*," | a11 a12 ..a1n1 | "
8. PRINT*," | | -1"
9. PRINT*,"A = | a21 a22 ..a2n1 | A = ?"
10. PRINT*," | . |"
11. PRINT*," | . |"
12. PRINT*," |_am11 am12..am1n1_|"
13. PRINT*," nxn "
14. PRINT*
15. PRINT*,"------------------------------------------------------------------------"
16. PRINT*
17. PRINT*," n ra vared konid : "
18. READ*,n
19. ALLOCATE(a(n,n),b(n-1,n-1),c(n,n),f(n-1),g(n,n))
20. DO i2=1,n
21. PRINT*," khate",i2,"matris a ra vared konid : "
22. READ*,a(i2,:)
23. END DO
24. PRINT*,"-----------------------------------------------------"
25. PRINT*
26. call det(n,a,deta)
27. IF (deta==0) THEN
28. PRINT*," matris makoos pazir nist! "
29. PRINT*
30. STOP
31. END IF
32. DO i1=1,n
33. DO j1=1,n
34. p=0
35. DO i=1,n
36. IF (i/=i1) THEN
37. k=0
38. DO j=1,n
39. IF (j/=j1) THEN
40. k=k+1
41. f(k)=a(i,j)
42. END IF
43. END DO
44. p=p+1
45. b(p,:)=f
46. END IF
47. END DO
48. call det(n-1,b,detr)
49. s=((-1)**(i1+j1))*detr
50. c(i1,j1)=s
51. END DO
52. END DO
53. DO j2=1,n
54. g(:,j2)=c(j2,:)
55. END DO
56. g=g/deta
57. PRINT*," -1 "
58. PRINT*," A : "
59. PRINT*
60. DO i3=1,n
61. PRINT*," ",g(i3,:)
62. END DO
63. PRINT*
64. END
65. subroutine det(n,a,t1)
66. IMPLICIT NONE
67. INTEGER::i,j,g,f,r,j1,k,s,n
68. REAL::landa,t,a(n,n),b(n),c(n,n),t1
69. c=a
70. k=0
71. DO i=1,n
72. IF (c(i,i)==0) THEN
73. DO j=i+1,n
74. IF (c(j,i)/=0) THEN
75. k=k+1
76. b=c(j,:)
77. c(j,:)=c(i,:)
78. c(i,:)=b
79. END IF
80. END DO
81. END IF
82. DO j1=i+1,n
83. landa=-c(j1,i)/c(i,i)
84. c(j1,:)=(landa*c(i,:))+c(j1,:)
85. END DO
86. END DO
87. t=1
88. DO s=1,n
89. t=t*c(s,s)
90. END DO
91. IF (MOD(k,2)==0) THEN
92. t1=t
93. ELSE
94. t1=-t
95. END IF
96. END
97.
98.
99.
100.