Explicando Vetor no Pascal

 

'subrotina de Gauss FreeBasic, Marcelo Paiva.
'Fonte:Adaptado Fortran,liv.Calculo Numerico c/Aplicacoes Leonidas Barroso, 2ªed.,editora HARPRA.

sub diagzero

print "O elemento da diagonal principal igual a zero 00000!!!!!"

end sub

sub ind

print "o sistema e indeterminado"

end sub

sub imp1

print "o sistema e impossivel"

end sub


sub gauss


dim i as integer
dim j as integer
dim mmax as integer
dim n as integer
dim nmax as integer
dim n1 as INTEGER
dim det as double
dim mult as double

dim ic as integer
dim k as integer
dim l as integer
dim lf as integer
dim li as integer
dim m as integer
dim mm as integer
'dim nc as integer

dim dta(1000) as string
dim c1 as integer
dim dd22(10,10) as string
dim as string token, tokens()
dim as integer pos1 = 1, pos2   ' changed pos1 to 1 (was 0)
dim idd22 as integer
dim jdd22 as integer
dim as string textline(1000)
dim As Integer pComma


mmax=20
nmax=mmax+1

dim a(mmax,nmax) as double
dim x(mmax) as double


idd22=0
jdd22=0

dim as integer r1 = open( "C:\Users\marcelopaiva\Documents\Projetos-FreeBasic\fbtextogauss-jordan-2\importcsv.csv" For Input as #1)
if r1 <> 0 then
    print "Error opening the file - error "; r1
    sleep
    end
end if

do until EOF(1)

'textline(c1)=""

jdd22=0

    line input #1, dta(c1)
    print

  print "c1 ",c1,"dta ",dta(c1)

do
    '' next comma position
    pos2 = instr(pos1, dta(c1), ";")
    'Print pos1, Pos2 : sleep,the substring between the last comma and it
    if pos2 > 0 Then
        token = mid(dta(c1), pos1, pos2 - pos1)    ' calc. len (new)
        'jdd22=jdd22+1
        'print token
    Else
        token = Mid(dta(c1), pos1)
        'jdd22=jdd22+1
        'print token
    end if
    
    '' add the token to the end of the array (slightly inefficient)
    redim preserve tokens(0 to ubound(tokens) + 1)
    tokens(ubound(tokens)) = token
    
    dd22(idd22,jdd22)=token

   pComma = InStr(1,dta(c1),";") 'Find next comma
   If pComma Then jdd22=jdd22+1
   jdd22=jdd22
    
    pos1 = pos2 + 1 ' added + 1
     
loop until pos2 = 0

   pos1 = 1

Print
Print "press a key --> QUIT ! ";
print
'' wait for user input, before prog. End
sleep

    c1=c1+1
    idd22=c1
     
loop

cls

print
locate n+1,3:print "matriz de coeficientes: "
print

for i as integer = 1 to c1
for j as integer = 1 to jdd22-1

    a(i,j)=val(dd22(i-1,j-1))
    locate (n+1+2)+2*i,2+8*j:print a(i,j)
     
next j
next i

print 

print "Press any key to exit"
sleep

cls
    
     n=c1
    
     l=n

'impressao da matriz de coeficientes e termos independentes

cls

n1=n+1
'nc=n/5
li=1
lf=0

 cls
 
 locate n+9,1:print "matriz de termos independentes: "
 print
     
 for i=1 to n
        locate n+10+i,3:print i;"   ";a(i,n1)

 next i
 'fim da impressao
 'metodo de gauss
  
 det=1
 mm=n-1
 for k=1 to mm
 
 if (abs(a(k,k))=0) then diagzero
 
 det=det*a(k,k)
 m=k+1
 
 for i=m to n
 mult=-a(i,k)/a(k,K)
 print ""
 print "det= ";det
 print ""
 print "mult= ";mult
 print ""
 
 for j=k to n1
 a(i,j)=a(i,j)+mult*a(k,j)
 
 next j
 next i
 next k    
 
 if (abs(a(n,n))=0) then ind
 
 if (abs(a(n,n1))=0) then imp1
 
 det=det*a(n,n)
 x(n)=a(n,n1)/a(n,n)
 k=n-1
 for i=1 to k
 l=n-i
 x(l)=a(l,n1)
 m=l+1
 for j=m to n
 x(l)=x(l)-a(l,j)*x(j)
 next j
 x(l)=x(l)/a(l,l)
 print "x(";l;") = ";x(l)
 next i
 '!fim do metodo de gauss
 
 '!impressao dos resultados
 'cls    
 print ""
 print "vetor solucao: "
 print ""
 for i=1 to n
 'locate 5+i,2:print Using "######.####";x(i)
 print Using "######.####";x(i)
 next i
 print
 'locate 10,2:print Using "######.####";det
 print Using "######.####";det
 
end sub

'rotina principal
    
'chama subrotina gauss, call gauss     
    
     gauss
      
sleep