home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / SIMPLX.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  2.2 KB  |  81 lines
  1. PROGRAM d10r12(input,output);
  2. (* driver for routine SIMPLX *)
  3. (* incorporates examples discussed in text *)
  4. CONST
  5.    n=4;
  6.    m=4;
  7.    np=5;   (* np >= n+1 *)
  8.    mp=6;   (* mp >= m+2 *)
  9.    m1=2;   (* m1+m2+m3=m *)
  10.    m2=1;
  11.    m3=1;
  12.    nm1m2=7;   (* nm1m2=n+m1+m2 *)
  13. TYPE
  14.    twochar = PACKED ARRAY [1..2] OF char;
  15.    glmpbynp = ARRAY [1..mp,1..np] OF real;
  16.    glnarray = ARRAY [1..n] OF integer;
  17.    glmarray = ARRAY [1..m] OF integer;
  18.    glnparray = ARRAY [1..np] OF integer;
  19.    glmparray = ARRAY [1..mp] OF integer;
  20. VAR
  21.    i,icase,j : integer;
  22.    izrov : glnarray;
  23.    iposv : glmarray;
  24.    a : glmpbynp;
  25.    txt : ARRAY [1..nm1m2] OF twochar;
  26.  
  27. (*$I MODFILE.PAS *)
  28. (*$I SIMP1.PAS *)
  29.  
  30. (*$I SIMP2.PAS *)
  31.  
  32. (*$I SIMP3.PAS *)
  33.  
  34. (*$I SIMPLX.PAS *)
  35.  
  36. BEGIN
  37.    txt[1] := 'x1'; txt[2] := 'x2'; txt[3] := 'x3';
  38.    txt[4] := 'x4'; txt[5] := 'y1'; txt[6] := 'y2';
  39.    txt[7] := 'y3';
  40.    a[1,1] := 0.0; a[1,2] := 1.0; a[1,3] := 1.0;
  41.    a[1,4] := 3.0; a[1,5] := -0.5;
  42.    a[2,1] := 740.0; a[2,2] := -1.0; a[2,3] := 0.0;
  43.    a[2,4] := -2.0; a[2,5] := 0.0;
  44.    a[3,1] := 0.0; a[3,2] := 0.0; a[3,3] := -2.0;
  45.    a[3,4] := 0.0; a[3,5] := 7.0;
  46.    a[4,1] := 0.5; a[4,2] := 0.0; a[4,3] := -1.0;
  47.    a[4,4] := 1.0; a[4,5] := -2.0;
  48.    a[5,1] := 9.0; a[5,2] := -1.0; a[5,3] := -1.0;
  49.    a[5,4] := -1.0; a[5,5] := -1.0;
  50.    simplx(a,m,n,mp,np,m1,m2,m3,icase,izrov,iposv);
  51.    writeln;
  52.    IF (icase = 1) THEN BEGIN
  53.       writeln('unbounded objective function')
  54.    END ELSE IF (icase = -1) THEN BEGIN
  55.       writeln('no solutions satisfy constraints given')
  56.    END ELSE BEGIN
  57.       write(' ':11);
  58.       FOR i := 1 to n DO BEGIN
  59.          IF (izrov[i] <= nm1m2) THEN BEGIN
  60.             write(txt[izrov[i]]:10)
  61.          END
  62.       END;
  63.       writeln;
  64.       FOR i := 1 to m+1 DO BEGIN
  65.          IF (i > 1) THEN BEGIN
  66.             write(txt[iposv[i-1]])
  67.          END ELSE BEGIN
  68.             write('  ')
  69.          END;
  70.          FOR j := 1 to (n+1) DO BEGIN
  71.             IF (j=1) THEN write(a[i,j]:10:2);
  72.             IF (j>1) THEN BEGIN
  73.                IF (izrov[j-1] <= nm1m2) THEN
  74.                   write(a[i,j]:10:2)
  75.             END
  76.          END;
  77.          writeln
  78.       END
  79.    END
  80. END.
  81.