! Program principal pt. GAUSS-SEIDEL
! Cu matricile: "A(n,n)" & "b(n)"
!
! Intrare = Fisier de date:
! 1) Titlu: text <= 80 caractere
! 2) n: nr. de ecuatii
! 3) Matricea coeficientilor "A": n x n (Se scrie pe linii si coloane).
! 4) Termenii liberi "b": "n" termeni liberi (pe linie).
! 5) eps, nlim: toleranta, numarul limita de iteratii
! 6) Cod_Tiparire: #0/=0: Se tiparesc/Nu se tiparesc iteratiile.
! 7) check_text: text <= 20 caractere.Primul caracter e semnificativ:
!				 C, c, P, p: se face proba.

Program Gauss_Seidel
real, allocatable :: a(:,:), b(:), x0(:), x1(:)
character(128) fname, dummy*80
real norm
logical Print_It
character(20) check_text; logical do_check;
character(30) text(0:1)
integer width


text(0) =' Toleranta atinsa.'
text(1) =' Numar de iteratii depasit.'

print '(a, \)', 'Input file: '
read '(a)', fname
open(1, file=fname, status ='old')

read(1,'(a80)') dummy	! Titlu
read(1,*) n
allocate (a(n,n), b(n), x0(n), x1(n))

do i=1,n
read(1,*) a(i,:)
enddo

read(1,*) b
read(1,*) eps, nlim
read(1,*) kodPrint
read(1,*) check_text


Print_It =kodPrint /=0
do_check =	check_text(1:1) =='C' .or. check_text(1:1) =='c' .or. &
			check_text(1:1) =='P' .or. check_text(1:1) =='p'

if(Print_It) write(1,'(/, a)') ' Iter	x' 

! Initializeaza "guess" vector:
x0 =0.

n8 =min(n,8)

! Iteratie:
ITER_DO: DO ITER =1, NLIM

DO1: DO i=1,n
sum =0.
	do2: do j=1,n
	
	if(j<=i-1) then
	xx =x1(j)
	elseif( j==i) then
	cycle do2
	else	! j>i
	xx =x0(j)
	endif
	sum =sum +a(i,j)*xx
	enddo do2
x1(i) =(b(i) - sum)/a(i,i)
enddo DO1

! Scrie iteratiile:
iwi =width(i)+2
if(Print_It) write(1, '(I<iwi>, t6, (<n8>g15.7))') iter, x1

! Test eroare:
if(norm(x1 -x0, n) <=eps) then
kod =0
exit ITER_DO

else
x0 =x1
endif

ENDDO ITER_DO

! Incheierea iteratiei cf. "kod":
write(1, '(/, a)') trim(text(kod))

! Scrie solutia:
!if(.not. Print_It) then

if(kod ==0) then
iwiter =width(iter)
write(1, '(a, I<iwiter>)') ' Numar iteratii: ', iter
write(1,'(/, a)') ' Solutia:'

else
write(1, '(/, a, I<iwiter>)') ' Numar iteratii: ', iter
write(1, '(/, a)') ' Ultima aproximatie:'
endif

do i=1,n
iwi =width(i)
write(1, '(a, i<iwi>, a, g15.7)') ' x(', i, ') =', x1(i)
enddo

if(do_check) then
write(1, '(/, a)') ' Proba "Ax-b":'

do i=1,n
e =0.
	do j=1,n
	e =e +a(i,j)*x1(j)
	enddo
e =e -b(i)

iwi =width(i)+1
write(1, '(I<iwi>, 1pg16.7)') i, e
enddo

endif

END Program Gauss_Seidel

