Program to illustrate use of procedures to read data into an array
and to sum the elements of an array.

	program doarray;
	type
		aray100 = array[1 .. 100] of real;
	var
		x: aray100;
		total, stop: real;
		size: integer;
		
	procedure inpara(var m:aray100; var used: integer; var sentinel:real);
		var
			i: integer;
			a: real;
		begin
		i := 0;
		writeln('Enter day item or', sentinel:10:3, ' to quit');
		readln(a);
		while a <> sentinel do
			begin
			i := i + 1;
			m[i] := a;
			writeln('Enter day item or', sentinel:10:3, ' to quit');
			readln(a);
			end;
		used := i;
		end;
	procedure sumara(var m:aray100; var used: integer; var sum:real);
		var
			i: integer;
		begin
		i := 0;
		sum := 0.0;
		while i < used do
			begin
			i := i + 1;
			sum := sum + m[i];
			end;
		end;

	begin
	stop := -1.0;
	inpara(x, size, stop);
	sumara(x, size, total);
	writeln(size, ' elements of array added up to', total:10:3);
	end.

Sample output;

>Enter day item or    -1.000 to quit
<3.45
>Enter day item or    -1.000 to quit
<-2.1
>Enter day item or    -1.000 to quit
<8.4
>Enter day item or    -1.000 to quit
<-1.0
>3 elements of array added up to     9.750

Program for entering and using a phone list.

	program lists;
	type
		strtype = array[1..50] of string;
	var
		lista, listb: strtype;
		n: integer;
		str: string;
	
	procedure getdata(var names, nums: strtype;var size:integer);
		var
			s: string;
			i: integer;
		begin
		i := 0;
		writeln('a?');
		readln(s);
		while length(s) > 0 do
			begin
			i := i + 1;
			names[i] := s;
			writeln('b?');
			readln(s);
			nums[i] := s;
			writeln('a?');
			readln(s);
			end;
		size := i;
	end;
	
	procedure findnum(var names, nums: strtype;var size:integer;
							var asked: string);
		var
			i: integer;
		begin
		i := 0;
		while i < size do
			begin
			i := i + 1;
			if asked = names[i] then
				begin
				writeln(nums[i]);
				end;
			end;
		end;
	
	begin
	getdata(lista, listb, n);
	writeln('name ?');
	readln(str);
	while length(str) > 0 do
		begin
		writeln('The number is');
        	findnum(lista, listb, n, str);
        	writeln('name ?');
        	readln(str);
		end;
	end.

Sample output:

>a?
<George
>b?
<x1234
>a?
<Marsha
>b?
<x3456
>a?
<George
>b?
<x1122
>a?
<Cindy
>b?
<x2112
>a?
<
>name ?
<Marsha
>The number is
>x3456
>name ?
<David
>The number is
>name ?
<George
>The number is
>x1234
>x1122
>name ?
<

Datase Program:

	program db;
	type
		a100 = array[1..20] of string;
	var
        	owner, color, make, age, style:a100;
		used: integer;
        	match, command: string;
	
	procedure load(var owner, color, make, age, style: a100;
							var used:integer);
		var
			i: integer;
			str: string;
		begin
		i := 0;
		writeln('Owner?');
		readln(str);
		while length(str) > 0 do
			begin
			i := i + 1;
			writeln('Enter color, make, age, style.');
			owner[i] := str;
			readln(color[i]);
			readln(make[i]);
			readln(age[i]);
			readln(style[i]);
			writeln('Owner?');
			readln(str);
			end;
		used := i;
		end;
	
	procedure compare(var a, b, c, d, e, v, w, x, y, z, match:string);
		begin
		if ((a=v) or (a='?')) and ((b=w) or (b='?')) and ((c=x) or
		  (c='?')) and ((d=y) or (d='?')) and ((e=z) or (e='?')) then
			begin
			match := 'yes';
			end
		else
			begin
			match := 'no';
			end;
        	end;
	procedure find(var owner, color, make, age, style: a100;
							var used:integer);
		var
			i: integer;
			a, b, c, d, e, str: string;
		begin
		writeln('Enter owner, color, make, age, style.');
		readln(a);
		readln(b);
		readln(c);
		readln(d);
		readln(e);
		i := 0;
		while i < used do
			begin
			i := i + 1;
			compare(a, b, c, d, e, owner[i], color[i], make[i],
									age[i],
				style[i], match);
			if match = 'yes' then
				begin
				writeln(owner[i]:15, color[i]:15, make[i]:15,
					age[i]:15, style[i]:15);
				end;
			end;
		end;
	begin
	writeln('?');
	readln(command);
	while command <> 'q' do
		begin
		if command = 'l' then
			begin
			load(owner, color, make, age, style, used);
			end;
		if command = 'f' then
			begin
			find(owner, color, make, age, style, used);
			end;
		writeln('?');
		readln(command);
	end;
	end.