home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / KENDL2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.3 KB  |  46 lines
  1. PROCEDURE kendl2(tab: gldarray; i,j,ip,jp: integer; VAR tau,z,prob: real);
  2. (* Programs using routine KENDL2 must define type
  3. TYPE
  4.    gldarray = ARRAY [1..ip,1..jp] OF real;
  5. in the calling program, where ip and jp are physical array dimensions
  6. large enough to encompass the logical dimensions i and j.   *)
  7. VAR
  8.    nn,mm,m2,m1,lj,li,l,kj,ki,k: integer;
  9.    svar,s,points,pairs,en2,en1: real;
  10. BEGIN
  11.    en1 := 0.0;
  12.    en2 := 0.0;
  13.    s := 0.0;
  14.    nn := i*j;
  15.    points := tab[i,j];
  16.    FOR k := 0 TO nn-2 DO BEGIN
  17.       ki := k DIV j;
  18.       kj := k-j*ki;
  19.       points := points+tab[ki+1,kj+1];
  20.       FOR l := k+1 TO nn-1 DO BEGIN
  21.          li := l DIV j;
  22.          lj := l-j*li;
  23.          m1 := li-ki;
  24.          m2 := lj-kj;
  25.          mm := m1*m2;
  26.          pairs := tab[ki+1,kj+1]*tab[li+1,lj+1];
  27.          IF (mm <> 0) THEN BEGIN
  28.             en1 := en1+pairs;
  29.             en2 := en2+pairs;
  30.             IF (mm > 0) THEN BEGIN
  31.                s := s+pairs
  32.             END ELSE BEGIN
  33.                s := s-pairs
  34.             END
  35.          END ELSE BEGIN
  36.             IF (m1 <> 0) THEN en1 := en1+pairs;
  37.             IF (m2 <> 0) THEN en2 := en2+pairs
  38.          END
  39.       END
  40.    END;
  41.    tau := s/sqrt(en1*en2);
  42.    svar := (4.0*points+10.0)/(9.0*points*(points-1.0));
  43.    z := tau/sqrt(svar);
  44.    prob := erfcc(abs(z)/1.4142136)
  45. END;
  46.