|
DataMuseum.dkPresents historical artifacts from the history of: RegneCentralen RC759 "Piccoline" |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RegneCentralen RC759 "Piccoline" Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 20992 (0x5200)
Types: TextFile
Names: »LP3.PAS«
└─⟦cd307176b⟧ Bits:30002666 Programmer fra Forlaget FAG ApS
└─⟦this⟧ »LP3.PAS«
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»