DataMuseum.dk

Presents historical artifacts from the history of:

RegneCentralen RC759 "Piccoline"

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RegneCentralen RC759 "Piccoline"

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦98f7296a0⟧ TextFile

    Length: 20992 (0x5200)
    Types: TextFile
    Names: »LP3.PAS«

Derivation

└─⟦cd307176b⟧ Bits:30002666 Programmer fra Forlaget FAG ApS
    └─ ⟦this⟧ »LP3.PAS« 

TextFile

program LP; (* Martin Rasmussen, Forlaget FAG, januar 1984 *)
const   (* COMPAS PASCAL version 3.02 *)
	maxm=25; maxn=25; (* kan maximalt vaere 40 *)
	maxmn=50; (* maxmn = maxm+maxn *)

type
	atype =	array(.1..maxm,1..maxmn.) of real;
	btype = array(.1..maxm.) of real;
	ctype = array(.1..maxmn.) of real;
	fil1type = record
			a:atype;
			b:btype;
			c:ctype;
			rn,rm:integer;
			vardi:real;
		   end;
	printype = (cons,prin,spog,clos);

var
	r:fil1type;
	kv:btype;
	bv:array(.1..maxm.) of integer;
	ibv:array(.1..maxmn.) of integer;
	c0: array(.1..maxn.) of real;
	n,m,n1,taller,stars,min,max,i,j,neghs:integer;
	vaerdi0,vaerdi1,bigm,min1,max1:real;
	svar:char;
	fil:string(.12.);
	fil1:file of fil1type;
	alleud,prt:boolean;
	outf:text;
	
procedure menu; forward;
procedure nulstil; forward;
procedure stop; forward;
procedure alletud; forward;
procedure printer(mode:printype); forward;
procedure forklaring; forward;
procedure erklaringer; forward;
procedure inddata; forward;
procedure indlas1; forward;
procedure indlas2; forward;
procedure rettelser; forward;
procedure retdata; forward;
function  hentdata:boolean; forward;
procedure gemdata; forward;
procedure simplexdata; forward;
procedure nykritfkt; forward;
procedure korsel; forward;
procedure pivot; forward;
procedure iteration; forward;
procedure uddata(stopud:boolean); forward;
procedure losning; forward;
procedure skyggepris; forward;


procedure menu;
begin
   repeat
	writeln(clrhom);writeln;
	writeln('       L I N E Æ R      P R O G R A M M E R I N G');
	writeln;
	writeln;
	writeln('       Der kan vælges mellem følgende muligheder:');
	writeln;
	writeln('   1.  Kørsel af ny LP opgave.');
	writeln;
	writeln('   2.  Kørsel af gammel LP opgave.');
	writeln;
	writeln('   3.  Gentag udskrivning af løsningen.');
	writeln;
	writeln('   4.  Forklaring.');
	writeln;
	writeln('   5.  Stop kørslen.');
	writeln;
		write('    Anfør det ønskede nummer > ');
		readln(svar); writeln;
	if svar in (.'1'..'4'.) then writeln(clrhom);
	case svar of
		'1':begin
			erklaringer;
			inddata;	
			rettelser;
			gemdata;
			alletud;
			printer(spog);
			simplexdata;
			korsel;
			printer(clos);
		    end;
		'2':if hentdata then begin 
			rettelser;
			gemdata;
			alletud;
			printer(spog);
			simplexdata;
			korsel;
			printer(clos);
		    end;
		'3':begin
			printer(spog);
			losning;
			printer(clos);
		    end;
		'4':forklaring;
	end;
    until svar='5';
end; (* menu *)

procedure nulstil;
begin
	fill(r,size(r),0); fill(kv,size(kv),0); fill(c0,size(c0),0);
	fill(bv,size(bv),0);   fill(ibv,size(ibv),0);
	r.vardi:=0;
	n:=0; m:=0; n1:=0; taller:=0; stars:=0; min:=0; max:=0; i:=0; j:=0;
	bigm:=0; min1:=0; max1:=0; neghs:=0; fil:='';
	alleud:=true; prt:=false;
end; (* nulstil *)

procedure stop;
begin
	writeln; writeln; writeln;
	writeln('** Fejlmeldingen er uden betydning. **');
	if 1/0=0 then;
end; (* stop *)

procedure alletud;
begin
	write('    Skal alle tabeller udskrives under kørsel (j/n) ? ');
	readln(svar); writeln;
	if svar in (.'j','J'.) then alleud:=true else alleud:=false;
end; (* alletud *)

procedure printer;
begin
	if mode=spog then
	begin
		write('    Ønskes udskrift på skærm/printer? (s/p) ');
		readln(svar); writeln;
		if svar in (.'p','P'.) then mode:=prin else mode:=cons;
	end;
	case mode of
		cons :begin
			assign(outf,'CON:');
			rewrite(outf); prt:=false;
		      end;
		prin :begin
			assign(outf,'LST:');
			rewrite(outf); prt:=true;
		      end;
		clos :begin
			close(outf); prt:=false;
		      end;
	end;
end; (* printer *)

procedure forklaring;
begin
	writeln(clrhom);writeln;
	writeln('   *******************************************************');
	writeln('   *  DETTE PROGRAM LØSER OPGAVER I LINEÆR PROGRAMMERING *');
	writeln('   *  PÅ FØLGENDE FORM.                                  *');
	writeln('   *                                                     *');
	writeln('   *  MAKSIMER:     C1*X1 + C2*X2 + ... +CN*XN + C0      *');
	writeln('   *                                                     *');
	writeln('   *  UNDER BIBETINGELSERNE:                             *');
	writeln('   *                                                     *');
	writeln('   *            A11*X1 + A12*X2 + ... + A1N*XN <= B1     *');
	writeln('   *               .        .              .       .     *');
	writeln('   *               .        .              .       .     *');
	writeln('   *            AM1*X1 + AM2*X2 + ... + AMN*XN <= BM     *');
	writeln('   *  HVOR                                               *');
	writeln('   *            N = ANTAL VARIABLE                       *');
	writeln('   *            M = ANTAL BIBETINGELSER                  *');
	writeln('   *                                                     *');
	writeln('   *                                                     *');
	writeln('   *  (c)   Martin Rasmussen        Tommy Borch          *');
	writeln('   *        Forlaget  FAG           December 1983.       *');
	writeln('   *******************************************************');
	writeln;
	write('    Tast return > '); readln(svar);
	writeln(clrhom);writeln;
	writeln('   *******************************************************');
	writeln('   *  ALLE BIBETINGELSER SKAL VÆRE BRAGT PÅ OVENNÆVNTE   *');
	writeln('   *  STANDARDFORM. KRITERIEFUNKTIONEN SKAL MAKSIMERES.  *');
	writeln('   *                                                     *');
	writeln('   *  ET MINIMUMSPROBLEM ÆNDRES TIL ET MAKSIMUMSPROBLEM  *');
	writeln('   *  VED AT GANGE KRITERIEFUNKTIONEN IGENNEM MED -1.    *');
	writeln('   *                                                     *');
	writeln('   *  HAR MAN ULIGHEDER AF TYPEN >= , SKAL ULIGHEDEN     *');
	writeln('   *  GANGES IGENNEM MED -1 FØR INDTASTNING AF DATA.     *');
	writeln('   *  HERVED KAN MAN FÅ EN NEGATIV HØJRESIDE.            *');
	writeln('   *  PROGRAMMET BENYTTER "STRAFFEMETODEN" TIL AT AF-    *');
	writeln('   *  SKAFFE EVENTUELLE NEGATIVE HØJRESIDER, OG TIL AT   *');
	writeln('   *  FREMBRINGE EN STARTBASIS MED KUNSTIGE VARIABLE.    *');
	writeln('   *                                                     *');
	writeln('   *  HAR MAN LIGNINGER, KAN DISSE OMSKRIVES TIL ULIGHE- *');
	writeln('   *  DER SOM I FØLGENDE EKSEMPEL:    X1 + X2 = 4        *');
	writeln('   *  OMSKRIVES TIL  X1 + X2 <= 4  OG  -X1 - X2 <= -4  . *');
	writeln('   *                                                     *');
	writeln('   *  N OG M ER KONSTANTER, SOM ER SAT TIL 25.           *');
	writeln('   *  DE KAN ØGES OP TIL 40 VED AT ÆNDRE I ERKLÆRINGERNE *');
	writeln('   *******************************************************');
	writeln;
	write('    Tast return > '); readln(svar);
end; (* forklaring *)

procedure erklaringer;
begin
	nulstil;
	writeln(clrhom);writeln;
	(*$I-*)
	repeat
		write('    Antal variable (max ',maxn,') ?      ');
		readln(n); writeln;
		write('    Antal bibetingelser (max ',maxm,') ? ');
		if iores=0 then readln(m); writeln;
	until (n>0) and (m>0) and (n<=maxn) and (m<=maxm) and (iores=0);
	(*$I+*)
	n1:=n; 
end; (* erklaringer *)

procedure inddata;
begin
	if (n<=9) and (m<=9) then indlas1 else indlas2;
end; (* inddata *)

procedure indlas1;
var
	i,j,pos,pos1,pos2,fejl:integer;
	svar:string(.20.);
begin
	writeln(clrhom);
	writeln('     BIBETINGELSER: ');
	for i:=1 to m do
	begin
		for j:=1 to n do
		begin
			pos:=10*(j-1);
			pos1:=pos mod 70+4;
			pos2:=i*2+pos div 70;
			gotoxy(pos1,pos2); writeln('0     X',j,'+');
		end;
		gotoxy(pos1+8,pos2); writeln(' <= ');
	end;
	for i:=1 to m do
	begin
		for j:=1 to n do
		begin
			pos:=10*(j-1);
			pos1:=pos mod 70+4;
			pos2:=i*2+pos div 70;
			repeat
				gotoxy(pos1,pos2); readln(svar);
				val(svar,r.a(.i,j.),fejl);
			until fejl=0;
		end;
		repeat
			gotoxy(pos1+12,pos2); readln(svar);
			val(svar,r.b(.i.),fejl);
		until fejl=0;
	end;
	gotoxy(5,pos2+2); writeln('KRITERIEFUNKTIONEN: ');
	for j:=1 to n do
	begin
		pos:=10*(j-1);
		pos1:=pos mod 70+4;
		pos2:=(m+2)*2+pos div 70;
		gotoxy(pos1,pos2); writeln('0     X',j,'+');
	end;
	gotoxy(pos1+15,pos2); writeln('0');
	for j:=1 to n do
	begin
		pos:=10*(j-1);
		pos1:=pos mod 70+4;
		pos2:=(m+2)*2+pos div 70;
		repeat
			gotoxy(pos1,pos2); readln(svar);
			val(svar,r.c(.j.),fejl);
		until fejl=0;
	end;
	repeat
		gotoxy(pos1+15,pos2); readln(svar);
		val(svar,r.vardi,fejl);
	until fejl=0;
end; (* indlas1 *)

procedure indlas2;
var
	i,j:integer;
begin
   writeln(clrhom);
   writeln('     BIBETINGELSER.','':31,'N = ',n,'   M = ',m);
   writeln('Kun koefficienter forskellig fra 0 skal indtastes.');
   writeln('Tast først nummeret på søjlen og så koefficientens talværdi.');
   writeln('Søjlenummer  0  afslutter en række i koefficient-matricen .');
   writeln;
   writeln('Række       Søjle               koefficient');
   for i:=1 to m do
   begin
	j:=0;
   	repeat
		j:=j+1;
   		(*$I-*)
   		repeat
   		write(i:3,'':12); read(j);
   		if (j>0) and (j<=n) and (iores=0) then
   		begin
   			write('':20,'A(',i,',',j,') =     ');
   			readln(r.a(.i,j.));
   		end else
   		begin
   			writeln;
   		end;
   		until iores=0;(*$I+*)
   	until (j=0) or (j=n);
   	(*$I-*)
   	repeat
   	write(i:3,'':33,'HØJRESIDE NR. ',i);
   	write('  B(',i,') = ');
   	readln(r.b(.i.));
   	until iores=0;(*$I+*)
   	writeln;
   end;
   writeln;
   writeln('      KRITERIEFUNKTIONEN: ');
   for j:=1 to n do
   begin (*$I-*) repeat
   	write('  C(',j,') = ');
   	read(r.c(.j.)); until iores=0;(*$I+*)
   	if j mod 4=0 then writeln;
   end;
   writeln;
   (*$I-*)repeat write('  konstanten C(0) = '); readln(r.vardi) until iores=0;
   (*$I+*)
end; (* indlas2 *)

procedure rettelser;
begin
	repeat
		printer(cons);
		uddata(false);
		printer(clos);
		write('    Er dette korrekt? (j/n) ');
		readln(svar); writeln;
		if not(svar in (.'j','J'.)) then retdata;
	until svar in (.'j','J'.);
end; (* rettelser *)

procedure retdata;
var	svar:char;
begin
	repeat
		writeln;
		write('    Rettelser i :  (a) A-matricen.  ');
		writeln('(venstresiderne)');
		write('                   (b) B-matricen.  ');
		writeln('(højresiderne)');
		writeln('                   (c) Kriteriefunktionen.');
		writeln('                   (d) Størrelsen af matricen.');
		writeln('                   (p) Matricen på printer.');
		writeln('                   (s) Stop rettelser');
		repeat
			write(clreol,'    Vælg bogstav >  ');
			read(svar);
			if ord(svar)>96 then svar:=chr(ord(svar)-32);
		until svar in (.'A','B','C','D','P','S'.);
		writeln;
		case svar of
			'A':begin
				(*$I-*)
				repeat
				write('    Anfør rækkenummer : ');
				readln(i);
				until iores=0;
				repeat
				write('       og søjlenummer : ');
				readln(j);
				until iores=0;
				repeat
				write(' A(',i,',',j,') = ');
				write(r.a(.i,j.):0:3,' = ');
				readln(r.a(.i,j.));
				until iores=0;(*$I+*)
			    end;
			'B':begin
				(*$I-*)
				repeat
				write('    Anfør rækkenummer : ');
				readln(i);
				until iores=0;
				write(' B(',i,') = ');
				repeat
				write(r.b(.i.):0:3,' = ');
				readln(r.b(.i.));
				until iores=0;(*$I+*)
			    end;
			'C':begin
				(*$I-*) repeat
				write('    Anfør nummeret på den variabel : ');
				readln(i);
				until iores=0;
				if i=0 then
				begin   repeat
					write(' C(0) = ');
					write(r.vardi:0:3,' = ');
					readln(r.vardi);
					until iores=0;
				end else
				begin   repeat
					write(' C(',i,') = ');
					write(r.c(.i.):0:3,' = ');
					readln(r.c(.i.));
					until iores=0;(*$I+*)
				end;
			    end;
			'D':begin (*$I-*)
				repeat
				write('    Anfør antal variable :      ');
				readln(n);
				until iores=0;
				repeat
				write('    Anfør antal bibetingelser : ');
				readln(m);
				until iores=0; (*$I+*)
				n1:=n;
			    end;
			'P':begin
				printer(prin);
				uddata(true);
				printer(clos);
			    end;
		end;				
	until svar in (.'s','S'.);
end; (* retdata *)

function hentdata;
var	ok: boolean;
begin
	repeat
	  write('    Hvad er filens navn? (højst 8 bogstaver) ');
	  buflen:=8; readln(fil); writeln;
	  if fil<>'' then fil:=fil+'.LPD';
	  assign(fil1,fil);
	  (*$I-*)  if fil<>'' then reset(fil1);(*$I+*)
	  ok:=iores=0;
	  if not ok and (fil<>'') then 
	  	writeln('    FEJL. FILEN FINDES IKKE. PRØV IGEN!');
	until ok or (fil='');
	if fil<>'' then begin read(fil1,r); close(fil1);
	n:=r.rn; m:=r.rm; n1:=n;end;
	hentdata:=fil<>'';
end; (* hentdata *)

procedure gemdata;
var	p: integer;
begin
	write('    Skal disse data gemmes på en fil? (j/n) ');
	svar:='j'; readln(svar); writeln;
	if svar in (.'j','J'.) then
	begin
		repeat
		   write('    Hvad er filens navn? (højst 8 bogstaver) ');
		   buflen:=8; readln(fil); writeln;
		until len(fil)<>0;
		p:=pos('.',fil); if p>0 then delete(fil,p,1);
		fil:=fil+'.LPD';
		r.rn:=n; r.rm:=m;
		assign(fil1,fil); rewrite(fil1);
		write(fil1,r); close(fil1);
	end;
end; (* gemdata *)

procedure simplexdata;
begin
	uddata(true);	min1:=1; neghs:=0;
	for i:=1 to m do
	begin
		if r.b(.i.)<0 then
		begin
			neghs:=neghs+1;
			for j:=1 to n do
			begin
				r.a(.i,j.):=-r.a(.i,j.);
				if (r.a(.i,j.)>0) and (r.a(.i,j.)<min1) then
					min1:=r.a(.i,j.);
			end;
			r.b(.i.):=-r.b(.i.);
			r.a(.i,n+neghs.):=-1;
			r.a(.i,n+m.):=-1;
		end;
	end;
	bigm:=0;vaerdi0:=r.vardi;
	for j:=1 to n do c0ÆjÅ:=r.cÆjÅ;
	n1:=n+neghs;
	if neghs>0 then
	begin
		stars:=10*(n1+1)+5;
		if stars>79 then stars:=79;
		nykritfkt;
	end;
end; (* simplexdata *)

procedure nykritfkt;
begin
	writeln(outf); writeln(outf,'    NEGATIV HØJRESIDE.');
	writeln(outf,'    KRITERIEFUNKTIONEN ÆNDRES VHA. "STRAFFEMETODEN"');
	writeln(outf);
	max1:=abs(r.c(.1.));
	for j:=2 to n do
	begin
		if abs(r.c(.j.))>max1 then max1:=abs(r.c(.j.));
	end;
	bigm:=8*max1/min1;
	writeln(outf,'        STORE M ER ',bigm:10:3);
	writeln(outf);
	if not prt then
	begin
		write('    tast return > '); readln(svar);
	end;
	for j:=1 to n do
	begin
		for i:=1 to m do
		begin
			if r.a(.i,n+m.)=-1 then r.c(.j.):=r.c(.j.)+
				bigm*r.a(.i,j.);
		end;
	end;
	for j:=n+1 to n1 do r.c(.j.):=-bigm;
	for i:=1 to m-1 do
	begin
		if r.a(.i,n+m.)=-1 then
		begin
			r.vardi:=r.vardi-bigm*r.b(.i.);
			r.a(.i,n+m.):=0;
		end;
	end;
	if r.a(.m,n+m.)=-1 then r.vardi:=r.vardi-bigm*r.b(.m.);
	uddata(true);
end; (* nykritfkt *)

procedure korsel;
begin
	for i:=1 to m do bv(.i.):=n1+i;
	for j:=1 to n1 do ibv(.j.):=j;
	if not alleud then
	begin	
		writeln(clrhom);
		writeln('Antal iterationer:');
	end;
	j:=1;
	while j<=n1 do
	begin
		if r.c(.j.)>0.0001 then
		begin
			max:=j;
			pivot;
			iteration;
			if alleud then uddata(true) else write(taller:10);
			j:=1;
		end else 
			j:=j+1;
	end;
	if not alleud then uddata(true);
	losning;
end; (* korsel *)

procedure pivot;
var	fundet:boolean;
begin
	max:=1; fundet:=false;
	for j:=2 to n1 do
	begin
		if r.c(.j.)>r.c(.max.) then max:=j;
	end;
	for i:=1 to m do
	begin
		if r.a(.i,max.)>0 then
		begin
			kv(.i.):=r.b(.i.)/r.a(.i,max.);
			fundet:=true; min:=i;
		end else
			kv(.i.):=-1;
	end;
	if not fundet then
	begin
		writeln(clrhom);writeln;
		writeln('*** UBEGRÆNSET LØSNING.  PROGRAMMET STOPPER. ***');
		stop;
	end else
	begin
		for i:=1 to m do
		begin
			if (kv(.i.)>=0) and (kv(.i.)<kv(.min.)) then min:=i;
		end;
	end;
end; (* pivot *)

procedure iteration;
var	husk:integer;
begin
	r.a(.min,max.):=1/r.a(.min,max.);
	for j:=1 to n1 do
	begin
		if j<>max then r.a(.min,j.):=r.a(.min,j.)*r.a(.min,max.);
	end;
	r.b(.min.):=r.b(.min.)*r.a(.min,max.);
	for i:=1 to m do
	begin
		if i<>min then r.a(.i,max.):=-r.a(.i,max.)*r.a(.min,max.);
	end;
	r.c(.max.):=-r.c(.max.)*r.a(.min,max.);
	for i:=1 to m do
	begin
		if i<>min then r.b(.i.):=r.b(.i.)+r.b(.min.)*r.a(.i,max.)/
						r.a(.min,max.);
	end;
	for j:=1 to n1 do
	begin
		if j<>max then r.c(.j.):=r.c(.j.)+r.c(.max.)*r.a(.min,j.)/
						r.a(.min,max.);
	end;
	for i:=1 to m do
	begin
		for j:=1 to n1 do
		begin
			if (i<>min) and (j<>max) then
			begin
				r.a(.i,j.):=r.a(.i,j.)+r.a(.i,max.)*
					r.a(.min,j.)/r.a(.min,max.);
			end;
		end;
	end;
	r.vardi:=r.vardi-r.b(.min.)*r.c(.max.)/r.a(.min,max.);
	husk:=ibv(.max.); ibv(.max.):=bv(.min.); bv(.min.):=husk;
	taller:=taller+1;
	if taller>30 then
	begin
		writeln(clrhom);writeln;	
		write('*** PROGRAMMET ER GÅET I LØKKE OG');
		writeln(' STOPPER DERFOR. ***');
		stop;
	end;
end; (* iteration *)

procedure uddata;
begin
	if taller=0 then
	begin
		writeln(clrhom);
		if prt then writeln(outf,@12);
		writeln(outf);
		writeln(outf);
		writeln(outf,'     START  SIMPLEX-TABELLEN');
		stars:=10*(n1+1)+5;
		if stars>80 then stars:=80;
	end else
	begin
		writeln(outf);
		writeln(outf);
		writeln(outf,'     SIMPLEX-TABEL NUMMER ',taller);
	end;
	for j:=1 to stars do write(outf,'*');
	for i:=1 to m do
	begin
		for j:=1 to n1 do
		begin
			if (j-1) mod 7=0 then writeln(outf);
			write(outf,r.a(.i,j.):10:3);
		end;
		if (n1-1) mod 7=6 then writeln(outf);
		writeln(outf,' :',r.b(.i.):10:3);
	end;
	for j:=1 to stars do write(outf,'-');
	for j:=1 to n1 do
	begin
		if (j-1) mod 7=0 then writeln(outf);
		write(outf,r.c(.j.):10:3);
	end;
	if (n1-1) mod 7=6 then writeln(outf);
	writeln(outf,' :',r.vardi:10:3);
	for j:=1 to stars do write(outf,'*');
	if taller>0 then
	begin
		for j:=1 to n1 do
		begin
			if (j-1) mod 7=0 then writeln(outf);
			write(outf,ibv(.j.):6,'    ');
		end;
		writeln(outf);
		writeln(outf,'    Ikke-basis variable.');
	end;
	if (not prt) and (stopud) then	
	begin
		writeln; write('    Tast return > '); read(svar);
	end else writeln(outf);
end; (* uddata *)

procedure losning;
var
	dimet,dimto:integer;
	fundet:boolean;
begin
	dimet:=0; dimto:=0; vaerdi1:=vaerdi0;
	writeln(clrhom);
	if prt then writeln(outf,@12);writeln;
	if len(fil)>0 then writeln(' ':54,'FIL : ',fil); writeln;
	for i:=1 to 27 do write(outf,'-');
	write(outf,' Løsning til LP opgaven. ');
	for i:=1 to 27 do write(outf,'-');
	writeln(outf); writeln(outf); writeln(outf);
	writeln(outf,'OPGAVEN ER LØST PÅ ',taller,' ITERATIONER.');
	writeln(outf);
	write(outf,'MAKSIMUM OPNÅS I PUNKTET:');
	for j:=1 to n do
	begin
		i:=1; fundet:=false;
		while (not fundet) and (i<=m) do
		begin
			if bv(.i.)=j then fundet:=true else i:=i+1;
		end;
		if (j-1) mod 4=0 then writeln(outf);
		if not fundet then
			write(outf,'  X(',j,') =  0        ')
		else
		  begin  write(outf,'  X(',j,') = ',r.b(.i.):10:3);
			 vaerdi1:=vaerdi1+r.b(.i.)*c0(.j.);
		  end;
	end;
	writeln(outf); writeln(outf);
	write(outf,'VÆRDIEN AF KRITERIEFUNKTIONEN I DETTE PUNKT ER ');
	writeln(outf,r.vardi:10:3);
	writeln(outf);
	for j:=1 to n1 do
	begin
		if r.c(.j.)=0 then dimet:=dimet+1;
	end;
	write(outf,'Dimensionen af det primære problems løsningsområde');
	writeln(outf,' er: ',dimet);
	writeln(outf);
	if abs(vaerdi1-r.vardi)>0.1 then
	   begin
	      writeln(outf,'   ADVARSEL!   INKONSISTENT LØSNING.');
	      writeln(outf,'   KUNSTIG VARIABEL I BASIS.');
	      writeln(outf,'   VÆRDIEN SKAL VÆRE',vaerdi1:10:3);
	      writeln(outf,'   MEN DEN ER BEREGNET TIL',r.vardi:10:3);
	      writeln(outf,'   LØSNINGSMÆNGDEN ER TOM')
	   end;
	if (neghs=0) or (neghs=m) then
	begin
		if prt then begin writeln; writeln; end;
		write('    Ønskes skyggepriser? (j/n) ');
		readln(svar); writeln;
		if not(svar in (.'n','N'.)) then
		begin
			skyggepris;
			for i:=1 to m do
			begin
				if abs(r.b(.i.))<=0.0001 then dimto:=dimto+1;
			end;
			writeln(outf);
			write(outf,'Dimensionen af det duale problems ');
			write(outf,'løsningsområde er: ');
			writeln(outf,dimto);
			writeln(outf);
		end;
	end;
	if not prt then
	begin
		write('    Tast return > '); readln(svar);
	end else writeln(outf);
end; (* losning *)

procedure skyggepris;
var
	i,j:integer;
	fundet:boolean;
begin
	writeln(outf); writeln(outf);
	write(outf,'SKYGGEPRISER FOR DE INDGÅENDE BEREGNINGER ER:');
	for i:=1 to m do
	begin
		j:=1; fundet:=false;
		while (not fundet) and (j<=n1) do
		begin
			if ibv(.j.)=i+n1 then fundet:=true else j:=j+1;
		end;
		if (i-1) mod 4=0 then writeln(outf);
		if not fundet then
			write(outf,'  Z(',i,') =  0        ')
		else
		   write(outf,'  Z(',i,') = ',abs(bigm+r.c(.j.)):10:3);
	end;
	writeln(outf); writeln(outf);
end; (* skyggepris *)

begin
	nulstil;
	menu;
	writeln;
end.
«eof»