code 34445;
procedure COMMUNICATION(POST,FA,N,M,NOBS,NBP,PAR,RES,BP,JTJINV,
IN,OUT,WEIGHT,NIS);
value POST,FA,N,M,NOBS,NBP,WEIGHT,NIS;
integer POST,N,M,NOBS,NBP,WEIGHT,NIS; real FA;
array PAR,RES,JTJINV,IN,OUT; integer array BP;
begin integer I,J; real C; array CONF[1:M];
if POST=5 then
begin OUTPUT(61,"("*,/,10B,"("THE FIRST RESIDUAL VECTOR")",//,16B,
"("I")",4B,"("RES[I]")",/")");
for I:=1 step 1 until NOBS do
OUTPUT(61,"("15B,ZD,2B,+.4D"+ZD,/")",I,RES[I]);
end else if POST=3 then
begin OUTPUT(61,"("*,/,
"("THE EUCLIDEAN NORM OF THE RESIDUAL VECTOR:")",
.7D"+ZD,2/,5B,"("CALCULATED PARAMETERS")",/")",
SQRT(VECVEC(1,NOBS,0,RES,RES)));
for I:=1 step 1 until M do
OUTPUT(61,"("9B,+.7D"+ZD,/")",PAR[I]);
OUTPUT(61,"("/,
"("NUMBER OF INTEGRATION STEPS PERFORMED: ")",ZZD,//")",NIS);
end else if POST=4 then
begin if NBP=0 then OUTPUT(61,"("*,//,5B,
"("THE MINIMIZATION IS STARTED WITHOUT BREAK-POINTS")"")") else
begin OUTPUT(61,"("*,5/,20B,
"("THE MINIMIZATION IS STARTED WITH W E I G H T =")",ZD,
3/")",WEIGHT);
OUTPUT(61,"("/,5B,
"("THE EXTRA PARAMETERS ARE THE OBSERVATIONS:")"")");
for I:=1 step 1 until NBP do
OUTPUT(61,"("8B,ZD,2B")",BP[I]);
end;
OUTPUT(61,"("6/,10B,
"("STARTING VALUES OF THE PARAMETERS")",/")");
for I:=1 step 1 until M do
OUTPUT(61,"("20B,+.7D"+ZD,/")",PAR[I]);
OUTPUT(61,"("//,
"("REL. TOLERANCE FOR THE EUCL. NORM OF THE RES. VECTOR:")"
,B,.7D"+ZD,/,
"("ABS. TOLERANCE FOR THE EUCL. NORM OF THE RES. VECTOR:")"
,B,.7D"+ZD,/,"("RELATIVE STARTING VALUE OF LAMBDA")",19B,
"(":")",B,.7D"+ZD")",IN[3],IN[4],IN[6])
end else if POST=1 then
begin
OUTPUT(61,"("10B,"("STARTING VALUES OF THE PARAMETERS")",/")");
for I:=1 step 1 until M do
OUTPUT(61,"("20B,+.7D"+ZD,/")",PAR[I]);
OUTPUT(61,"("2/,"("NUMBER OF EQUATIONS")",3B,"(":")",ZD,/,
"("NUMBER OF OBSERVATIONS:")",ZD,2/,
"("MACHINE PRECISION")",30B,"(":")",+.D"+ZD,/,
"("RELATIVE LOCAL ERROR BOUND FOR INTEGRATION")",5B,"(":")",+.D"+ZD,/,
"("RELATIVE TOLERANCE FOR RESIDUE")",17B,"(":")",+.2D"+ZD,/,
"("ABSOLUTE TOLERANCE FOR RESIDUE")",17B,"(":")",+.2D"+ZD,/,
"("MAXIMUM NUMBER OF INTEGRATIONS TO PERFORM")",6B,"(":")",ZZD,/,
"("RELATIVE STARTING VALUE OF LAMBDA")",14B,"(":")",+.2D"+ZD,/,
"("RELATIVE MINIMAL STEPLENGTH")",20B,"(":")",+.2D"+ZD,/")",
N,NOBS,IN[0],IN[2],IN[3],IN[4],IN[5],IN[6],IN[1]);
if NBP=0 then OUTPUT(61,"("//,
"("THERE ARE NO BREAK-POINTS")"")") else
begin OUTPUT(61,"("//,
"("BREAK-POINTS ARE THE OBSERVATIONS :")"")");
for I:=1 step 1 until NBP do
OUTPUT(61,"("ZZD,B")",BP[I])
end;
OUTPUT(61,"("//,
"("THE ALPHA-POINT OF THE F-DISTIBUTION :")",
ZD.DD")",FA);
end else if POST=2 then
begin OUTPUT(61,"("*")"); if OUT[1]=0 then OUTPUT(61,"("2/,
"("NORMAL TERMINATION OF THE PROCESS")"")")
else if OUT[1]=1 then OUTPUT(61,"("2/,
"("NUMBER OF INTEGRATIONS ALLOWED WAS EXCEEDED")"")")
else if OUT[1]=2 then OUTPUT(61,"("2/,
"("MINIMAL STEPLENGTH WAS DECREASED FOUR TIMES")"")")
else if OUT[1]=3 then OUTPUT(61,"("2/,
"("A CALL OF DERIV DELIVERED FALSE")"")")
else if OUT[1]=4 then OUTPUT(61,"("2/,
"("A CALL OF JAC DFDY DELIVERED FALSE ")"")")
else if OUT[1]=5 then OUTPUT(61,"("2/,
"("A CALL OF JAC DFDP DELIVERED FALSE ")"")")
else if OUT[1]=6 then OUTPUT(61,"("2/,
"("PRECISION ASKED FOR MAY NOT BE ATTAINED")"")");
if NBP=0 then OUTPUT(61,"("2/,
"("LAST INTEGRATION WAS PERFORMED WITHOUT BREAK-POINTS")"")") else
begin OUTPUT(61,"("2/,
"("THE PROCESS STOPPED WITH BREAK-POINTS: ")"")");
for I:=1 step 1 until NBP do
OUTPUT(61,"("ZZD,B")",BP[I])
end;
OUTPUT(61,"("4/,
"("EUCL. NORM OF THE LAST RESIDUAL VECTOR :")",.7D"+ZD,/,
"("EUCL. NORM OF THE FIRST RESIDUAL VECTOR:")",.7D"+ZD,/,
"("NUMBER OF INTEGRATIONS PERFORMED")",7B,"(":")",ZZD,/,
"("LAST IMPROVEMENT OF THE EUCLIDEAN NORM :")",.7D"+ZD,/,
"("CONDITON NUMBER OF J'*J")",15B,"(":")",.7D"+ZD,/,
"("LOCAL ERROR BOUND WAS EXCEEDED (MAXIM.):")",ZZD,7/")",
OUT[2],OUT[3],OUT[4],OUT[6],OUT[7],OUT[5]);
comment STATISTICS FOR THE PARAMETERS;
OUTPUT(61,"("//,B,"("PARAMETERS")",12B,"("CONFIDENCE INTERVAL")",
/")");
for I:=1 step 1 until M do
begin CONF[I]:=SQRT(M*FA*JTJINV[I,I]/(NOBS-M))*OUT[2];
OUTPUT(61,"("+.7D"+ZD,12B,+.7D"+ZD,/")",PAR[I],CONF[I]);
end;
C:=if NOBS=M then 0 else OUT[2]*OUT[2]/(NOBS-M);
OUTPUT(61,"("5/,"("CORRELATION MATRIX")",11B,"("COVARIANCE MATRIX")",
/")");
for I:=1 step 1 until M do
begin for J:=1 step 1 until M do
begin if I=J then OUTPUT(61,"("29B")");
if I>J then OUTPUT(61,"("+.7D"+ZD,B")",
JTJINV[I,J]/SQRT(JTJINV[I,I]*JTJINV[J,J]))
else OUTPUT(61,"("+.7D"+ZD,B")",JTJINV[I,J]*C)
end; OUTPUT(61,"("/")");
end; OUTPUT(61,"("*")");
OUTPUT(61,"("3/,10B,"("THE LAST RESIDUAL VECTOR")",//,15B,
"("I")",4B,"("RES[I]")",/")");
for I:=1 step 1 until NOBS do
OUTPUT(61,"("14B,ZD,2B,+.4D"+ZD,/")",I,RES[I])
end
end COMMUNICATION;
eop