PROGRAM d13r18(input,output);
(* driver for routine KENDL1 *)
(* look for correlations in ran0, ran3 and ran4 *)
CONST
   ndat=200;
TYPE
   gl32array = ARRAY [1..32] OF integer;
   gl48array = ARRAY [1..48] OF integer;
   gl56array = ARRAY [1..56] OF integer;
   gl64array = ARRAY [1..64] OF integer;
   glnarray = ARRAY [1..ndat] OF real;
   name = PACKED ARRAY [1..4] OF char;
   gl65reals = ARRAY [1..65] OF real;
VAR
   glnewkey : integer;
   glinp,glkey,ip,ipm : gl64array;
   glpow : gl65reals;
   glicd,ipc1 : gl56array;
   ipc2,iet : gl48array;
   ipp : gl32array;
   is : ARRAY [1..16,1..4,1..8] OF integer;
   ibin : ARRAY [1..4,1..16] OF integer;
   ksflg,cyflg,desflg : boolean;
   gliseed : integer;
   gly : real;
   glv : ARRAY [1..97] OF real;
   glinext,glinextp : integer;
   glma : ARRAY [1..55] OF real;
   i,idum,j : integer;
   prob,tau,z : real;
   data1,data2 : glnarray;
   txt : ARRAY [1..3] OF name;

(*$I MODFILE.PAS *)
(*$I RAN0.PAS *)

(*$I RAN3.PAS *)

(*$I DESKS.PAS *)

(*$I DES.PAS *)

(*$I RAN4.PAS *)

(*$I ERFCC.PAS *)

(*$I KENDL1.PAS *)

BEGIN
   ksflg := true;
   cyflg := true;
   desflg := true;
   txt[1] := 'RAN0'; txt[2] := 'RAN3'; txt[3] := 'RAN4';
   writeln;
   writeln('Pair correlations of RAN0, RAN3 and RAN4');
   writeln;
   writeln('Program':9,'Kendall tau':17,'Std. Dev.':16,'Probability':18);
   FOR i := 1 to 3 DO BEGIN
      idum := -1357;
      FOR j := 1 to ndat DO BEGIN
         IF (i = 1) THEN BEGIN
            data1[j] := ran0(idum);
            data2[j] := ran0(idum)
         END ELSE IF (i = 2) THEN BEGIN
            data1[j] := ran3(idum);
            data2[j] := ran3(idum)
         END ELSE IF (i = 3) THEN BEGIN
            data1[j] := ran4(idum);
            data2[j] := ran4(idum)
         END
      END;
      kendl1(data1,data2,ndat,tau,z,prob);
      writeln (txt[i]:8,tau:17:6,z:17:6,prob:17:6)
   END
END.
PROGRAM d13r19(input,output);
(* driver for routine KENDL2 *)
(* look for 'ones-after-zeros' in irbit1 and irbit2 sequences *)
CONST
   ndat=1000;
   ip=8;
   jp=8;
TYPE
   gldarray = ARRAY [1..ip,1..jp] OF real;
   pattern = PACKED ARRAY [1..3] OF char;
VAR
   ifunc,iseed,i,j,k,l,m,n,twoton : integer;
   prob,tau,z : real;
   tab : gldarray;
   txt : ARRAY [1..8] OF pattern;

(*$I MODFILE.PAS *)
(*$I IRBIT1.PAS *)

(*$I IRBIT2.PAS *)

(*$I ERFCC.PAS *)

(*$I KENDL2.PAS *)

BEGIN
   txt[1] := '000'; txt[2] := '001';
   txt[3] := '010'; txt[4] := '011';
   txt[5] := '100'; txt[6] := '101';
   txt[7] := '110'; txt[8] := '111';
   i := ip;
   j := jp;
   writeln ('Are ones followed by zeros and vice-versa?');
   FOR ifunc := 1 to 2 DO BEGIN
      iseed := 2468;
      IF (ifunc = 1) THEN BEGIN
         writeln('test of irbit1:')
      END ELSE BEGIN
         writeln('test of irbit2:')
      END;
      FOR k := 1 to i DO BEGIN
         FOR l := 1 to j DO BEGIN
            tab[k,l] := 0.0
         END
      END;
      FOR m := 1 to ndat DO BEGIN
         k := 1;
         twoton := 1;
         FOR n := 0 to 2 DO BEGIN
            IF (ifunc = 1) THEN BEGIN
               k := k+irbit1(iseed)*twoton
            END ELSE BEGIN
               k := k+irbit2(iseed)*twoton
            END;
            twoton := 2*twoton
         END;
         l := 1;
         twoton := 1;
         FOR n := 0 to 2 DO BEGIN
            IF (ifunc = 1) THEN BEGIN
               l := l+irbit1(iseed)*twoton
            END ELSE BEGIN
               l := l+irbit2(iseed)*twoton
            END;
            twoton := 2*twoton
         END;
         tab[k,l] := tab[k,l]+1.0
      END;
      kendl2(tab,i,j,ip,jp,tau,z,prob);
      write(' ':4);
      FOR n := 1 to 8 DO BEGIN
         write(txt[n]:6)
      END;
      writeln;
      FOR n := 1 to 8 DO BEGIN
         write(txt[n]:3);
         FOR m := 1 to 8 DO BEGIN
            write(round(tab[n,m]):6)
         END;
         writeln
      END;
      writeln;
      writeln('kendall tau':17,'std. dev.':14,'probability':16);
      writeln(tau:15:6,z:15:6,prob:15:6);
      writeln
   END
END.
PROGRAM d13r10(input,output);
(* driver for routine KSONE *)
CONST
   npts=1000;
   eps=0.1;
TYPE
   gldarray = ARRAY [1..npts] OF real;
   glsarray = gldarray;
VAR
   glinext,glinextp : integer;
   glma : ARRAY [1..55] OF real;
   gliset : integer;
   glgset : real;
   i,idum,j : integer;
   d,factr,prob,varnce : real;
   data : gldarray;

(*$I MODFILE.PAS *)
(*$I SORT.PAS *)

(*$I PROBKS.PAS *)

(*$I RAN3.PAS *)

(*$I GASDEV.PAS *)

(*$I ERFCC.PAS *)

FUNCTION func(x: real): real;
VAR
   y : real;
BEGIN
   y := x/sqrt(2.0);
   func := 1.0 - erfcc(y)
END;

(*$I KSONE.PAS *)

BEGIN
   gliset := 0;
   idum := -5;
   writeln('variance ratio':19,'k-s statistic':16,'probability':15);
   writeln;
   FOR i := 1 to 11 DO BEGIN
      varnce := 1.0+(i-1)*eps;
      factr := sqrt(varnce);
      FOR j := 1 to npts DO BEGIN
         data[j] := factr*abs(gasdev(idum))
      END;
      ksone(data,npts,d,prob);
      writeln(varnce:16:6,d:16:6,prob:16:6)
   END
END.
PROGRAM d13r11(input,output);
(* driver for routine KSTWO *)
CONST
   n1=500;
   n2=100;
   eps=0.2;
TYPE
   glarray1 = ARRAY [1..n1] OF real;
   glarray2 = ARRAY [1..n2] OF real;
   glsarray = glarray1;
VAR
   glinext,glinextp : integer;
   glma : ARRAY [1..55] OF real;
   gliset : integer;
   glgset : real;
   i,idum,j : integer;
   d,factr,prob,varnce : real;
   data1 : glarray1;
   data2 : glarray2;

(*$I MODFILE.PAS *)
(*$I PROBKS.PAS *)

(*$I SORT.PAS *)

(*$I RAN3.PAS *)

(*$I GASDEV.PAS *)

(*$I KSTWO.PAS *)

BEGIN
   gliset := 0;
   idum := -1357;
   FOR i := 1 to n1 DO BEGIN
      data1[i] := gasdev(idum)
   END;
   writeln('variance ratio':18,'k-s statistic':15,'probability':14);
   idum := -2468;
   FOR i := 1 to 11 DO BEGIN
      varnce := 1.0+(i-1)*eps;
      factr := sqrt(varnce);
      FOR j := 1 to n2 DO BEGIN
         data2[j] := factr*gasdev(idum)
      END;
      kstwo(data1,n1,data2,n2,d,prob);
      writeln(varnce:15:6,d:15:6,prob:15:6)
   END
END.
