code 34137;
procedure LSQDECOMP( A, N ,M ,N1 ,AUX ,AID ,CI );
value N , M ,N1;integer N,M,N1;array A,AUX, AID;
integer array CI;
begin integer J,K,KPIV,NR,S;boolean FSUM;
    real BETA,SIGMA,NORM,AIDK,AKK,W,EPS;
    array SUM[1:M];

    NORM:=0 ; AUX[3]:=M;NR:=N1;FSUM:=true;
    for K:=1 step 1 until M do 
        begin if K=N1+1 then begin FSUM:=true; NR:=N end;
        if FSUM then 
        for J:=K step 1 until M do 
        begin W:=SUM[J]:= TAMMAT(K ,NR ,J ,J ,A ,A);
                if W>NORM then NORM:=W
        end; FSUM:=false;EPS:=AUX[2]*SQRT(NORM);
        SIGMA:=SUM[K]; KPIV:=K;
        for J:=K+1 step 1 until M do 
        if SUM[J]>SIGMA then 
        begin SIGMA:=SUM[J]; KPIV:=J end;
        if KPIV^=K then 
        begin SUM[KPIV]:=SUM[K]; ICHCOL( 1 ,N ,K ,KPIV ,A) end;
        CI[K]:=KPIV; AKK:=A[K,K];
        SIGMA:=TAMMAT(K ,NR ,K ,K ,A ,A); W:=SQRT(SIGMA);
        AIDK:=AID[K]:=if AKK<0 then W else -W;
        if W<EPS then 
        begin AUX[3]:=K-1;goto ENDDEC end;
        BETA:= 1/(SIGMA-AKK*AIDK); A[K,K]:=AKK-AIDK;
        for J:=K+1 step 1 until M do 
        begin ELMCOL(K ,NR ,J ,K ,A ,A ,-BETA*TAMMAT(K ,NR ,
        K ,J ,A ,A)); SUM[J]:=SUM[J]-A[K,J]**2
        end;
        if K=N1 then 
        for J:=N1+1 step 1 until N do 
        for S:=1 step 1 until M do 
        begin NR:=if S>N1 then N1 else S-1;
        W:=A[J,S]-MATMAT(1 ,NR , J ,S ,A ,A);
        A[J,S]:=if S>N1 then W else W/AID[S]
        end 
    end FOR K;
  ENDDEC:
end LSQDECOMP;
        eop