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