code 34291;
procedure DECSYM2(A,N,TOL,AUX,P,DETAUX);
value N;integer N;real TOL;
array A,DETAUX;integer array P,AUX;
begin integer I,J,K,M,IP1,IP2,DUMMY;boolean ONEBYONE,SYM;
    real DET,S,T,ALPHA,LAMBDA,SIGMA,AII,AIP1,AIP1I;
    AUX[3]:=AUX[4]:=0;SYM:=true;I:=0;
    for DUMMY:=0 while SYM and (I<N) do 
    begin I:=I+1;J:=I;
      for M:=0 while SYM and (J<N) do 
      begin J:=J+1;SYM:=SYM and (A[I,J]=A[J,I]) end;
    end;
    if SYM then AUX[2]:=1
        else begin AUX[2]:=0;goto ENDDEC end;
    ALPHA:=(1+SQRT(17))/8;P[N]:=N;I:=1;
    for DUMMY:=0 while I<N do 
    begin IP1:=I+1;IP2:=I+2;AII:=ABS(A[I,I]);P[I]:=I;
      LAMBDA:=ABS(A[I,IP1]);J:=IP1;
      for M:=IP2 step 1 until N do 
      if ABS(A[I,M])>LAMBDA then 
      begin J:=M;LAMBDA:=ABS(A[I,M]) end;
      T:=ALPHA*LAMBDA;ONEBYONE:=true;
      if AII<T then 
      begin SIGMA:=LAMBDA;
         for M:=IP1 step 1 until J-1 do 
            if ABS(A[M,J])>SIGMA then SIGMA:=ABS(A[M,J]);
         for M:=J+1 step 1 until N do 
            if ABS(A[J,M])>SIGMA then SIGMA:=ABS(A[J,M]);
         if SIGMA*AII<LAMBDA then 
         begin if ALPHA*SIGMA<ABS(A[J,J]) then 
            begin ICHROW(J+1,N,I,J,A);ICHROWCOL(IP1,J-1,I,J,A);
               T:=A[I,I];A[I,I]:=A[J,J];A[J,J]:=T;P[I]:=J
            end 
            else 
            begin if J>IP1 then 
              begin ICHROW(J+1,N,IP1,J,A);ICHROWCOL(IP2,J-1,IP1,J,A);
                  T:=A[I,I];A[I,I]:=A[J,J];A[J,J]:=T;
                  T:=A[I,J];A[I,J]:=A[I,IP1];A[I,IP1]:=T
               end;
               DET:=A[I,I]*A[IP1,IP1]-A[I,IP1]**2;AIP1I:=A[I,IP1]/DET;
               AII:=A[I,I]/DET;AIP1:=A[IP1,IP1]/DET;P[I]:=J;P[IP1]:=0;
               DETAUX[I]:=1;DETAUX[IP1]:=DET;
               for J:=IP2 step 1 until N do 
               begin S:=AIP1I*A[IP1,J]-AIP1*A[I,J];
                  T:=AIP1I*A[I,J]-AII*A[IP1,J];ELMROW(J,N,J,I,A,A,S);
                  ELMROW(J,N,J,IP1,A,A,T);A[I,J]:=S;A[IP1,J]:=T
               end;
               AUX[3]:=AUX[3]+1;AUX[4]:=AUX[4]+1;I:=IP2;
               ONEBYONE:=false 
            end 
         end 
      end;
      if ONEBYONE then 
      begin if TOL<ABS(A[I,I]) then 
         begin AII:=A[I,I];DETAUX[I]:=A[I,I];
            if AII>0 then AUX[3]:=AUX[3]+1 else AUX[4]:=AUX[4]+1;
            for J:=IP1 step 1 until N do 
           begin S:=-A[I,J]/AII;ELMROW(J,N,J,I,A,A,S);A[I,J]:=S end 
         end;I:=IP1
      end 
    end WHILE I;
    if I=N then 
    begin if TOL<ABS(A[N,N]) then 
      begin if A[N,N]>0 then AUX[3]:=AUX[3]+1
              else AUX[4]:=AUX[4]+1
      end;DETAUX[N]:=A[N,N]
    end;
  ENDDEC:
    AUX[5]:=N-AUX[3]-AUX[4]
end DECSYM2;
        eop