home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / COVSRT.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  2.1 KB  |  88 lines
  1. PROGRAM d14r3(input,output);
  2. (* driver for routine COVSRT *)
  3. CONST
  4.    ma=10;
  5.    mfit=5;
  6. TYPE
  7.    glcovar = ARRAY [1..ma,1..ma] OF real;
  8.    gllista = ARRAY [1..mfit] OF integer;
  9. VAR
  10.    i,j : integer;
  11.    covar : glcovar;
  12.    lista : gllista;
  13.  
  14. (*$I MODFILE.PAS *)
  15. (*$I COVSRT.PAS *)
  16.  
  17. BEGIN
  18.    FOR i := 1 to ma DO BEGIN
  19.       FOR j := 1 to ma DO BEGIN
  20.          covar[i,j] := 0.0;
  21.          IF ((i <= 5) AND (j <= 5)) THEN BEGIN
  22.             covar[i,j] := i+j-1
  23.          END
  24.       END
  25.    END;
  26.    writeln;
  27.    writeln('original matrix');
  28.    FOR i := 1 to ma DO BEGIN
  29.       FOR j := 1 to ma DO write(covar[i,j]:4:1);
  30.       writeln
  31.    END;
  32.    writeln(' press RETURN to continue...');
  33.    readln;
  34. (* test 1 - spread by 2 *)
  35.    writeln;
  36.    writeln('test #1 - spread by two');
  37.    FOR i := 1 to mfit DO BEGIN
  38.       lista[i] := 2*i
  39.    END;
  40.    covsrt(covar,ma,ma,lista,mfit);
  41.    FOR i := 1 to ma DO BEGIN
  42.       FOR j := 1 to ma DO write(covar[i,j]:4:1);
  43.       writeln
  44.    END;
  45.    writeln(' press RETURN to continue...');
  46.    readln;
  47. (* test 2 - reverse *)
  48.    writeln;
  49.    writeln('test #2 - reverse');
  50.    FOR i := 1 to ma DO BEGIN
  51.       FOR j := 1 to ma DO BEGIN
  52.          covar[i,j] := 0.0;
  53.          IF  ((i <= 5) AND (j <= 5)) THEN BEGIN
  54.             covar[i,j] := i+j-1
  55.          END
  56.       END
  57.    END;
  58.    FOR i := 1 to mfit DO BEGIN
  59.       lista[i] := mfit+1-i
  60.    END;
  61.    covsrt(covar,ma,ma,lista,mfit);
  62.    FOR i := 1 to ma DO BEGIN
  63.       FOR j := 1 to ma DO write(covar[i,j]:4:1);
  64.       writeln
  65.    END;
  66.    writeln(' press RETURN to continue...');
  67.    readln;
  68. (* test 3 - spread and reverse *)
  69.    writeln;
  70.    writeln('test #3 - spread and reverse');
  71.    FOR i := 1 to ma DO BEGIN
  72.       FOR j := 1 to ma DO BEGIN
  73.          covar[i,j] := 0.0;
  74.          IF ((i <= 5) AND (j <= 5)) THEN BEGIN
  75.             covar[i,j] := i+j-1
  76.          END
  77.       END
  78.    END;
  79.    FOR i := 1 to mfit DO BEGIN
  80.       lista[i] := ma+2-2*i
  81.    END;
  82.    covsrt(covar,ma,ma,lista,mfit);
  83.    FOR i := 1 to ma DO BEGIN
  84.       FOR j := 1 to ma DO write(covar[i,j]:4:1);
  85.       writeln
  86.    END
  87. END.
  88.