PROGRAM Equation_Set_Solution_by_Gauss_Sidel_Method
!This program have been written by Pedram Niakan
IMPLICIT NONE
DOUBLE PRECISION :: er,sum
DOUBLE PRECISION,ALLOCATABLE :: a
,
,b
),x
),y
)
INTEGER :: i,j,k,n
!Declaration of the matrix of factors
WRITE (*,*) "Please enter number of Equations & Variables:"
READ (*,*) n
ALLOCATE (a(1:n,1:n))
ALLOCATE (b(1:n))
ALLOCATE (x(1:n),y(1:n))
WRITE (*,*) "Please generat the matrix of factors:"
DO i=1,n
DO j=1,n
WRITE (*,*) "Please enter array (",i,",",j,") for matrix of factors"
READ (*,*) a(i,j)
END DO
WRITE (*,*) "Please enter array (",i,") for matrix of values"
READ (*,*) b(i)
END DO
WRITE (*,*) "The 3 required matrixes for these equations system have been generated successfully"
WRITE (*,*)""
WRITE (*,*) "Please enter",n," probable numbers:"
DO i=1,n,1
WRITE (*,*) "Please enter the probable root: x(",i,")="
READ (*,*) y(i)
x(i)=y(i)
END DO
k=1
10 DO i=1,n,1
sum=b(i)/a(i,i)
DO j=1,n,1
IF (j/=i) THEN
x(i)=(-a(i,j)*x(j))/a(i,i)+sum
sum=x(i)
END IF
END DO
END DO
er=0
DO i=1,n,1
er=DABS((x(i)-y(i))/y(i))+er
END DO
IF (er<=0.010000000) THEN !Accuracy
DO i=1,n,1
WRITE (*,*) "Accurate Root: X(",i,")=",x(i)
END DO
WRITE (*,*) "Number of retries:",k
ELSE
DO i=1,n,1
WRITE (*,*) "Approximate Root: X(",i,")=",x(i)
y(i)=x(i)
END DO
WRITE (*,*) "Try:",k
k=k+1
PAUSE
GO TO 10
END IF
PAUSE
END PROGRAM
من برنامش رو نوشتم لطفا خودت به سابروتین تبدیلش کن
