Climate data

'The earth is warming' say the IPCC and all associated researchers 'and mankind is to blame'. I agree with the first part. Earth is warming since we are moving away from an ice age, 8,000 years ago. But I deny the second part.
The 'researchers' claim that earth gets hotter every year by a few tenths of a degree. I'm not sure of this kind of data is measurable at all. So I want to apply real statistics to the climate data. The climate scientists only publish averages but I am interested in the standard deviation (sd). The sd gives an impression about the reliability of the data.
Of course I contacted the national KNMI climate institute. 'We do not use the sd', they say, 'because it is hard to interpret'. I agree with that. It is hard to interpret a prime factor that can eradicate a global theory based on quicksand.

I donwload some files from the Dutch Met-office (www.knmi.nl). These are huge, comma delimited, data files with daily values. In 20 year periods that is 7000 records. Some stations date back over 100 years. That's the kind of data to process. But only a computer can do so.

Process climate data

Below is the source of the first version that works and does nothing useful at all.

MODULE klim02;

IMPORT	ASCII, Arguments, InOut, Strings, BasicIO, MemPools;

CONST	MaxBuff			= 10000000;

TYPE	ChPOINTER		= POINTER TO ARRAY [0..MaxBuff] OF CHAR;

VAR	chr			: CHAR;
	int			: INTEGER;
	i, j, offset, fsize	: CARDINAL;
	inFile, outFile		: BasicIO.File;
	fileName		: Strings.String;
	DataPool		: MemPools.MemPool;
	DataStart		: ChPOINTER;


PROCEDURE FileSize (FileName : Strings.String) : CARDINAL;

CONST	Chunk		= 1024;

VAR	n, size		: CARDINAL;
	m		: INTEGER;
	inF		: BasicIO.File;
	tmpPool		: MemPools.MemPool;
	tmpPtr		: POINTER TO CHAR;

BEGIN
  n := 0;	m := 0;
  BasicIO.OpenInput (inF, FileName);
  IF  NOT BasicIO.DONE  THEN  RETURN 0  END;
  MemPools.NewPool (tmpPool);
  MemPools.PoolAllocate (tmpPool, tmpPtr, Chunk);
  REPEAT
    BasicIO.Read (inF, tmpPtr, Chunk, m);
    INC (n, Chunk)
  UNTIL m # Chunk;
  DEC (n, Chunk);
  size := n + CARDINAL (m);
  MemPools.KillPool (tmpPool);
  BasicIO.Close (inF);
  RETURN size
END FileSize;


PROCEDURE Read (VAR chr : CHAR);

BEGIN
  chr := DataStart^[offset];
  IF  offset <= fsize  THEN
    INC (offset)
  ELSE
    chr := 0C
  END;
END Read;


PROCEDURE UnRead;

BEGIN
  IF  offset > 0  THEN  DEC (offset)  END
END UnRead;


PROCEDURE SkipWs;

VAR	ch	: CHAR;

BEGIN
  REPEAT  Read (ch)  UNTIL  ch > ' '
END SkipWs;


PROCEDURE SkipTo (token : CHAR);

VAR	ch	: CHAR;

BEGIN
  REPEAT
    Read (ch)
  UNTIL  ch = token;
  UnRead
END SkipTo;


PROCEDURE Init;

VAR	count		: SHORTCARD;
	cRead		: INTEGER;
	option		: Strings.String;
	buffer		: Arguments.ArgTable;

BEGIN
  Arguments.GetArgs (count, buffer);
  IF  count = 1  THEN
    InOut.WriteString ("Please specify a file to read");
    InOut.WriteLn;
    HALT
  END;
  Strings.Assign (fileName, buffer^[1]^);
  fsize := FileSize (fileName);
  IF  fsize = 0  THEN  
    InOut.WriteString ("Empty file; aborting.");
    InOut.WriteLn;
    HALT
  END;
  InOut.WriteString ('Opened file "');			InOut.WriteString (fileName);
  InOut.WriteString ('" (');				InOut.WriteCard (fsize, 2);
  InOut.WriteString (" bytes). Buffering data.");	InOut.WriteLn;
  MemPools.NewPool (DataPool);
  MemPools.PoolAllocate (DataPool, DataStart, fsize + 128);
  BasicIO.OpenInput (inFile, fileName);
  BasicIO.Read (inFile, DataStart, fsize, cRead);
  IF  CARDINAL (cRead) # fsize  THEN
    InOut.WriteString ("Error while reading file; aborting");
    InOut.WriteLn;
    ShutDown;
    HALT
  END;
  offset := 0;
END Init;


PROCEDURE ShutDown;

BEGIN
  MemPools.KillPool (DataPool);
  InOut.WriteString ("Data pools destroyed, files closed, shutting down.");
  InOut.WriteLn
END ShutDown;


BEGIN
  Init;
  ShutDown
END klim02.
   
It reads the command line arguments, determines the size of the source file, sets up a buffer to hold the entire file in memory and then shuts down by closing the file and dumping the memory pools. But it is a clean compile! It took some time to find the right form to be able to walk through the buffered file. I do not want to use the buffered I/O which is given by TextIO and similar. The most important reason is: I cannot go back more than 1 character. And why not use all this memory in my computer?

In C it is easy: you create a pointer that points to the data and then you increment the pointer to walk through the buffer. But pointer arithmatic is not allowed in Wirthin languages. So a first attempt to do
VAR	ChPtr		= POINTER TO CHAR;
...
ch := ChPtr^;
INC (ChPtr);
   
did not compile. For obvious reasons. So I thought that perhaps the C approach would pay off by trying
VAR	ChPtr		: POINTER TO CHAR;
	offset		: CARDINAL;
...
ch := ChPtr^[offset];
INC (offset);
   
But that was abusing a pointer. On the internet there was nothing to be found. But Wirth et al were able to create a text editor in their days. Realy fine graphical text editors similar to KWord. So there MUST be a way to do what I want. And then I remembered the way in which the ArgBuffer TYPE was defined in Arguments.def to have a EUREKA event.
CONST	MaxBuff			= 10000000;
TYPE	ChPOINTER		= POINTER TO ARRAY [0..MaxBuff] OF CHAR;
...
VAR	offset			: CARDINAL;
	DataStart		: ChPOINTER;
...
PROCEDURE Read (VAR chr : CHAR);

BEGIN
  chr := DataStart^[offset];
  IF  offset <= fsize  THEN
    INC (offset)
  ELSE
    chr := 0C
  END;
END Read;
...
MemPools.PoolAllocate (DataPool, DataStart, fsize + 128);
   
The trick is to define a TYPE that describes a pointer to a linear array (ChPOINTER) and then create a buffer in dynamic memory that is linked to the DataStart pointer. Then the offset is added to the address of the pointer to walk through the buffered file. So THIS is how an editor or word processor is defined.

There's just one little drawback: the buffertype cannot be dynamicaaly created. It must be described at compile time, not at run time. So I have to set it big enough. Experience has learned that it is not a problem to have a pointer that is able to address 10 million bytes, pointing to a 20,000 bytes buffer. The problem now is, that the compiler is not in the position that pointing to element 20,001 is an illegal operation. But I trust the Linux memory management system to keep an eye on things. Hmm. It's easy to try of course....
$ klim02 etm.txt
Opened file "etm.txt" (37108 bytes). Buffering data.
Data pools destroyed, files closed, shutting down.
$
   
Nope, reading is possible beyond the end of the buffer. How about writing?
$ klim02 etm.txt
Opened file "etm.txt" (37108 bytes). Buffering data.
Data pools destroyed, files closed, shutting down.
$
   
Nope. This is what I changed to the source:
  offset := 50000;
  Read (chr);
  DataStart^[50000] := chr
END Init;
   
So this is a potentially dangerous operation.

Final version of klim02

My style is to start with a working core and then extend that core. So klim02.mod finally ended as follows:

MODULE klim02;

IMPORT	ASCII, Arguments, InOut, Strings, BasicIO, MemPools;

CONST	MaxBuff			= 20 * 1024 * 1024;
	NaN			= MIN (INTEGER) + 1;

TYPE	ChPOINTER		= POINTER TO ARRAY [0..MaxBuff] OF CHAR;

VAR	chr			: CHAR;
	int			: INTEGER;
	i, j, offset, fsize	: CARDINAL;
	EOF			: BOOLEAN;
	inFile, outFile		: BasicIO.File;
	fileName		: Strings.String;
	DataPool		: MemPools.MemPool;
	DataStart		: ChPOINTER;


PROCEDURE FileSize (FileName : Strings.String) : CARDINAL;

CONST	Chunk		= 1024;

VAR	n, size		: CARDINAL;
	m		: INTEGER;
	inF		: BasicIO.File;
	tmpPool		: MemPools.MemPool;
	tmpPtr		: POINTER TO CHAR;

BEGIN
  n := 0;	m := 0;
  BasicIO.OpenInput (inF, FileName);
  IF  NOT BasicIO.DONE  THEN  RETURN 0  END;
  MemPools.NewPool (tmpPool);
  MemPools.PoolAllocate (tmpPool, tmpPtr, Chunk);
  REPEAT
    BasicIO.Read (inF, tmpPtr, Chunk, m);
    INC (n, Chunk)
  UNTIL m # Chunk;
  DEC (n, Chunk);
  size := n + CARDINAL (m);
  MemPools.KillPool (tmpPool);
  BasicIO.Close (inF);
  RETURN size
END FileSize;


PROCEDURE Read (VAR chr : CHAR);

BEGIN
  chr := DataStart^[offset];
  IF  offset < fsize - 1  THEN
    INC (offset);	EOF := FALSE
  ELSE
    chr := 0C;		EOF := TRUE
  END
END Read;


PROCEDURE UnRead;

BEGIN
  IF  offset > 0  THEN  DEC (offset)  END
END UnRead;


PROCEDURE SkipWs;

VAR	ch	: CHAR;

BEGIN
  REPEAT  Read (ch)  UNTIL  (ch > ' ') OR EOF;
  UnRead
END SkipWs;


PROCEDURE SkipTo (token : CHAR);

VAR	ch	: CHAR;

BEGIN
  REPEAT  Read (ch)  UNTIL  (ch = token) OR EOF
END SkipTo;


PROCEDURE Init;

VAR	count		: SHORTCARD;
	cRead		: INTEGER;
	option		: Strings.String;
	buffer		: Arguments.ArgTable;

BEGIN
  Arguments.GetArgs (count, buffer);
  IF  count = 1  THEN
    InOut.WriteString ("Please specify a file to read");
    InOut.WriteLn;
    HALT
  END;
  Strings.Assign (fileName, buffer^[1]^);
  fsize := FileSize (fileName);
  IF  fsize = 0  THEN  
    InOut.WriteString ("Empty file; aborting.");
    InOut.WriteLn;
    HALT
  END;
  InOut.WriteString ('Opened file "');			InOut.WriteString (fileName);
  InOut.WriteString ('" (');				InOut.WriteCard (fsize, 2);
  InOut.WriteString (" bytes). Buffering data.");	InOut.WriteLn;
  MemPools.NewPool (DataPool);
  MemPools.PoolAllocate (DataPool, DataStart, fsize + 128);
  BasicIO.OpenInput (inFile, fileName);
  BasicIO.Read (inFile, DataStart, fsize, cRead);
  IF  CARDINAL (cRead) # fsize  THEN
    InOut.WriteString ("Error while reading file; aborting");
    InOut.WriteLn;
    ShutDown;
    HALT
  END;
  offset := 0;
END Init;


PROCEDURE ReadInt (VAR  num  : INTEGER);

VAR	i, sign		: INTEGER;
	ch		: CHAR;

BEGIN
  sign := 1;		num := 0;
  REPEAT  
    Read (ch);
    IF  EOF  THEN  RETURN  END;
  UNTIL  ch > ' ';
  IF  ch = '-'  THEN  sign := -1;  Read (ch)  END;
  IF  ch = ','  THEN  num := NaN;  RETURN     END;
  LOOP
    IF  EOF  THEN  EXIT  END;
    IF  ('0' > ch) OR (ch > '9')  THEN  
      num := NaN;
      SkipTo (',');
      RETURN
    END; 
    i := ORD (ch) - ORD ('0');
    num := 10 * num + i;
    Read (ch);
    IF  ch = ','  THEN  EXIT  END;
  END;
  num := num * sign
END ReadInt;


PROCEDURE ShutDown;

BEGIN
  MemPools.KillPool (DataPool);
  InOut.WriteLn;
  InOut.WriteString ("Data pools destroyed, files closed, shutting down.");
  InOut.WriteLn
END ShutDown;


BEGIN
  Init;
  i := 1;
  SkipTo ("#");		SkipTo (12C);
  LOOP
    ReadInt (int);
    IF  EOF  THEN  EXIT  END;
    IF  int # NaN  THEN  InOut.WriteInt (int, 10)  ELSE  InOut.WriteString ("       NaN")  END;
    IF  i MOD 10 = 0  THEN  InOut.WriteLn  END;
    INC (i);
    IF  i = 42  THEN  InOut.WriteLn; i := 1 END;
  END;
  ShutDown
END klim02.
   
This version will open a file, determine the file size, arrange memory, buffer the full file in RAM and next go through it to skip the header section and read all integers (and print them as well). Even the big files, containing 30.000 records, are processed correctly and at high speed. I checked records at random places and all of them seem to be processed right. That means that the data is processed in the right way.

The SkipWs and SkipTo procedures turned out to be wrong. The former needed an UnRead operation, the latter not.

Store a record

Now that we can read a series of integers it is time to see if we can read one line of data and store it in a record. Also, why waste the names of the fields? That is the target for klim03. Here are the sections that are changed with respect to klim02:

MODULE klim03;

TYPE	DataStore		= ARRAY [0..49] OF INTEGER;
	Field			= ARRAY [0..15] OF CHAR;
	FieldsStore		= ARRAY [0..49] OF Field;
	DataPtr			= POINTER TO DataNode;
	DataNode		= RECORD
				    store	: DataStore;
				    next	: DataPtr
				  END;
	
	Datum			= RECORD
				    year	: SHORTCARD;
				    month, day	: CHAR
				  END;
   
Some new types to make life easier on the poor programmer. A little bit too many literals still in this section. But that's for a later issue.
VAR	EOF, Done		: BOOLEAN;
	DataStart, FirstRec	: DataPtr;
	Record			: DataStore;
	Fields			: FieldsStore;
   
New global variables.
PROCEDURE W84Key (key : CHAR);

VAR	ch	: CHAR;

BEGIN
  REPEAT InOut.Read (ch) UNTIL ch = key
END W84Key;
A debugging routine; it will halt execution until the required key was pressed.
PROCEDURE Store (VAR  record  : DataStore);

BEGIN
  
END Store;
An empty procedure. Waiting to be filled, like a mailbox in early morning.
PROCEDURE Date2Int (date : Datum) : INTEGER;

BEGIN
  RETURN  10000 * VAL (INTEGER, date.year) + 100 * VAL (INTEGER, (ORD (date.month) + ORD (date.day)))
END Date2Int;


PROCEDURE Int2Date (num : INTEGER; VAR  date : Datum);

BEGIN
  date.day   := CHR (num MOD 100);
  date.month := CHR ((num DIV 100) MOD 100);
  date.year  := VAL (SHORTCARD, (num DIV 10000))
END Int2Date;
Procedures for conversion between INTEGER and Year-Month-Day dates. Take a look at Date2Int for the type casts.
PROCEDURE GetRecord (VAR  rec  : DataStore) : BOOLEAN;

VAR	i	: CARDINAL;

BEGIN
  i := 0;
  LOOP
    ReadInt (rec [i]);
    INC (i);
    IF  EOF OR (i = 41)  THEN  EXIT  END
  END;
  IF  EOF  THEN  RETURN FALSE  ELSE  RETURN TRUE  END
END GetRecord;
   
The FOR loop reads 41 INTEGERS in a row and stores them in a temporary array.
PROCEDURE GetField (VAR str : Field) (* : BOOLEAN *);

VAR	ch	: CHAR;
	n	: CARDINAL;

BEGIN
  n := 0;
  REPEAT  Read (ch)  UNTIL  (ch > ' ') OR EOF;
  REPEAT
    str [n] := ch;
    INC (n);
    Read (ch)
  UNTIL (ch = ',') OR (ch = 12C) OR (n = HIGH (str)) OR EOF;
  IF  n < HIGH (str)  THEN  str [n] := 0C  ELSE  SkipTo (',')  END;
(*  IF  EOF  THEN  RETURN FALSE  ELSE  RETURN TRUE  END  *)
END GetField;


PROCEDURE GetFields (VAR store : FieldsStore);

VAR	i	: CARDINAL;
	name	: Field;

BEGIN
  FOR i := 0 TO 40  DO
    GetField (name);
    store [i] := name
  END
END GetFields;
   
GetField reads in one fieldname. GetFields reads in all fieldnames. Take care here. All field names are terminated by a comma, but not the last one. The last one is followed bt an EOL.
BEGIN
  Init;
  i := 1;
  SkipTo ("#");
  GetFields (Fields);
  REPEAT
    Done := GetRecord (Record);
    IF  Done  THEN  InOut.Write (".")  END
  UNTIL NOT Done;
  ShutDown
END klim03.
   
If you count the dots, you get the same number as the amount of records.

Klim05 : read, buffer, show

After a two years rest I took up programming again and after a few days I had klim05 stable. It offers:

See it run:
bash-4.2$ klim05 etmgeg_310.txt 
Opened file "etmgeg_310.txt" (9858163 bytes). Buffering data.

Fields =  41
  0 : STN
  1 : YYYYMMDD    2 : DDVEC       3 : FHVEC       4 : FG          5 : FHX
  6 : FHXH        7 : FHN         8 : FHNH        9 : FXX        10 : FXXH
 11 : TG         12 : TN         13 : TNH        14 : TX         15 : TXH
 16 : T10N       17 : T10NH      18 : SQ         19 : SP         20 : Q
 21 : DR         22 : RH         23 : RHX        24 : RHXH       25 : PG
 26 : PX         27 : PXH        28 : PN         29 : PNH        30 : VVN
 31 : VVNH       32 : VVX        33 : VVXH       34 : NG         35 : UG
 36 : UX         37 : UXH        38 : UN         39 : UNH        40 : EV24

Records in memory
Records processed : 39255

Data pools destroyed, files closed, shutting down.
bash-4.2$
Data is read in and stored to dynamic memory properly. There were some minor hickups but most of them were related to typo's and one major error was in using the wrong datatype... That's the disadvantage of a strongly typed language. Here is the full source of klim05.mod:
MODULE klim05;

IMPORT	SYSTEM, ASCII, Arguments, InOut, Strings, BasicIO, MemPools;

CONST	MaxBuff			= 20 * 1024 * 1024;
	MaxFieldNum		= 42;
	MaxFieldLen		= 16;
	NaN			= MIN (INTEGER) + 1;		(* NaN = Not a Number *)

TYPE	ChPOINTER		= POINTER TO ARRAY [0 .. MaxBuff] OF CHAR;
	Field			= ARRAY [0 .. MaxFieldLen - 1] OF CHAR;
	DataStore		= ARRAY [0 .. MaxFieldNum - 1] OF INTEGER;
	FieldsStore		= ARRAY [0 .. MaxFieldNum - 1] OF Field;
	DataPtr			= POINTER TO DataNode;
	DataNode		= RECORD
				    store	: DataStore;
				    next	: DataPtr
				  END;
	Datum			= RECORD
				    year	: SHORTCARD;
				    month, day	: CHAR
				  END;


VAR	records, fields,
	i, j, offset, fsize	: CARDINAL;
	lastChar		: CHAR;
	EOF, Done		: BOOLEAN;
	inFile, outFile		: BasicIO.File;
	fileName		: Strings.String;
	TextPool, DataPool	: MemPools.MemPool;
	TextBuff		: ChPOINTER;
	Record			: DataStore;
	LastRec, FirstRec	: DataPtr;
	Fields			: FieldsStore;


PROCEDURE W84Key (key : CHAR);

VAR	ch	: CHAR;

BEGIN
  REPEAT  InOut.Read (ch)  UNTIL  ch = key
END W84Key;


PROCEDURE Abort (nr : CARDINAL);

BEGIN
  CASE  nr  OF
    1 :	InOut.WriteString ("Out of memory")		|
    2 : InOut.WriteString ("Error while reading file")	|
    3 : InOut.WriteString ("Too many fields found") 
  END;
  InOut.WriteString (", aborting.");	InOut.WriteLn;
  ShutDown;
  HALT
END Abort;


PROCEDURE Read (VAR chr : CHAR);

BEGIN
  chr := TextBuff^ [offset];
  IF  offset < fsize - 1  THEN
    INC (offset);
    EOF := FALSE
  ELSE
    chr := 0C;
    EOF := TRUE
  END;
  lastChar := chr
END Read;


PROCEDURE UnRead;

BEGIN
  IF  offset > 0  THEN  DEC (offset)  END
END UnRead;


PROCEDURE SkipWs;

VAR	ch	: CHAR;

BEGIN
  REPEAT  Read (ch)  UNTIL  (ch > ' ') OR EOF;
  UnRead
END SkipWs;


PROCEDURE SkipTo (token : CHAR);

VAR	ch	: CHAR;

BEGIN
  REPEAT  Read (ch)  UNTIL  (ch = token) OR EOF
END SkipTo;


PROCEDURE ReadInt (VAR  num  : INTEGER);

VAR	i, sign		: INTEGER;
	ch		: CHAR;

BEGIN
  sign := 1;		num := 0;
  REPEAT  Read (ch)  UNTIL  EOF OR (ch > ' ');
  IF  ch = '-'  THEN
    sign := -1;
    Read (ch)
  END;
  IF  ch = ','  THEN
    num := NaN;
    RETURN
  END;
  LOOP
    IF  EOF  THEN  EXIT  END;
    IF  (ch < '0') OR (ch > '9')  THEN  
      num := NaN;
      SkipTo (',');
      RETURN
    END; 
    i := ORD (ch) - ORD ('0');
    num := 10 * num + i;
    Read (ch);
    IF  ch = ','  THEN  EXIT  END;
  END;
  num := num * sign
END ReadInt;


PROCEDURE Date2Int (date : Datum) : INTEGER;

BEGIN
  RETURN  10000 * VAL (INTEGER, date.year) + 100 * VAL (INTEGER, (ORD (date.month) + ORD (date.day)))
END Date2Int;


PROCEDURE Int2Date (num : INTEGER; VAR  date : Datum);

BEGIN
  date.day   := CHR (num MOD 100);
  date.month := CHR ((num DIV 100) MOD 100);
  date.year  := VAL (SHORTCARD, (num DIV 10000))
END Int2Date;


PROCEDURE FileSize (FileName : Strings.String) : CARDINAL;

CONST	Chunk		= 1024;

VAR	n, size		: CARDINAL;
	m		: INTEGER;
	inF		: BasicIO.File;
	tmpPool		: MemPools.MemPool;
	tmpPtr		: POINTER TO CHAR;

BEGIN
  n := 0;	m := 0;
  BasicIO.OpenInput (inF, FileName);
  IF  NOT BasicIO.DONE  THEN  RETURN 0  END;
  MemPools.NewPool (tmpPool);
  MemPools.PoolAllocate (tmpPool, tmpPtr, Chunk);
  REPEAT
    BasicIO.Read (inF, tmpPtr, Chunk, m);
    INC (n, Chunk)
  UNTIL m # Chunk;
  DEC (n, Chunk);
  size := n + CARDINAL (m);
  MemPools.KillPool (tmpPool);
  BasicIO.Close (inF);
  RETURN size
END FileSize;


PROCEDURE GetRecord (VAR  rec  : DataStore) : BOOLEAN;

VAR	i	: CARDINAL;
	res	: BOOLEAN;

BEGIN
  i := 0;	res := FALSE;
  REPEAT
    ReadInt (rec [i]);
    INC (i)
  UNTIL  EOF OR (i = fields);
  IF  NOT EOF  THEN  
    INC (records);
    res := TRUE
  END;
  RETURN res
END GetRecord;


PROCEDURE StoreRecord (VAR rec  : DataStore);

VAR	new	: DataPtr;

BEGIN
  MemPools.PoolAllocate (DataPool, new, SYSTEM.TSIZE (DataNode));
  IF  new = NIL  THEN  Abort (1)  END;
  WITH  new^  DO
    store := rec;		(* Bulk copy records	*)
    next  := NIL		(* Initialize pointer	*)
  END;
  IF  LastRec = NIL  THEN	(* Is this the first record?		*)
    FirstRec := new		(* If so, keep it's address		*)
  ELSE
    LastRec^.next := new	(* If not, make a linked list		*)
  END;
  LastRec := new		(* Remember last record's address	*)
END StoreRecord;


PROCEDURE ShowRecord (rec : DataStore);

VAR	i	: CARDINAL;

BEGIN
  i := 0;
  REPEAT
    (* 
    InOut.WriteString (Fields [i]);	InOut.Write (ASCII.ht); InOut.WriteString ("= ");
    *)
    IF  rec [i] = NaN  THEN
      InOut.WriteString ("NaN")
    ELSE
      InOut.WriteInt (rec [i], 1)
    END;
    IF  (i = 0) OR (i MOD 6 # 0)  THEN  InOut.Write (ASCII.ht)  ELSE  InOut.WriteLn  END;
    INC (i)
  UNTIL i = fields;
  InOut.WriteLn;	InOut.WriteLn
END ShowRecord;


PROCEDURE DumpRecord (x : CARDINAL);

VAR	this	: DataPtr;
	i	: CARDINAL;

BEGIN
  this := FirstRec;
  i := 1;
  WHILE  (i < x) AND (this^.next # NIL)  DO
    this := this^.next;
    INC (i)
  END;
  ShowRecord (this^.store)
END DumpRecord;


PROCEDURE GetField (VAR str : Field);

VAR	ch	: CHAR;
	n	: CARDINAL;

BEGIN
  n := 0;
  REPEAT  Read (ch)  UNTIL  (ch > ' ') OR EOF;
  REPEAT
    str [n] := ch;
    INC (n);
    Read (ch)
  UNTIL (ch = ',') OR (ch < ' ') OR (n = HIGH (str)) OR EOF;
  IF  n < HIGH (str)  THEN  
    str [n] := 0C
  ELSE
    SkipTo (',')
  END
END GetField;


PROCEDURE GetFields (VAR store : FieldsStore);

VAR	i	: CARDINAL;
	name	: Field;

BEGIN
  SkipTo ("#");			(* FieldsList starts with a '#'	*)
  i := 0;
  REPEAT
    GetField (name);
    store [i] := name;
    INC (fields);
    INC (i);
    IF  fields = MaxFieldNum  THEN  RETURN  END
  UNTIL  lastChar < ' '		(* EOL is end of fields definition	*)
END GetFields;


PROCEDURE ShowFields (store : FieldsStore);

VAR	i	: CARDINAL;

BEGIN
  InOut.WriteLn;
  InOut.WriteString ("Fields = ");	InOut.WriteCard (fields, 3);	InOut.WriteLn;
  FOR  i := 0  TO  fields - 1  DO
    InOut.WriteCard (i, 3);
    InOut.WriteString (" : ");		InOut.WriteString (store [i]);
    IF  i MOD 5 # 0  THEN
      InOut.Write (ASCII.ht)
    ELSE
      InOut.WriteLn
    END
  END;
  InOut.WriteLn
END ShowFields;


PROCEDURE Init;

VAR	count		: SHORTCARD;
	cRead		: INTEGER;
	option		: Strings.String;
	buffer		: Arguments.ArgTable;

BEGIN
  Arguments.GetArgs (count, buffer);
  IF  count = 1  THEN
    InOut.WriteString ("Please specify a file to read");
    InOut.WriteLn;
    HALT
  END;
  Strings.Assign (fileName, buffer^ [1]^);
  fsize := FileSize (fileName);
  IF  fsize = 0  THEN
    InOut.WriteString ("Empty file; aborting.");	InOut.WriteLn;
    HALT
  END;
  InOut.WriteString ('Opened file "');			InOut.WriteString (fileName);
  InOut.WriteString ('" (');				InOut.WriteCard (fsize, 2);
  InOut.WriteString (" bytes). Buffering data.");	InOut.WriteLn;
  MemPools.NewPool (TextPool);
  MemPools.PoolAllocate (TextPool, TextBuff, fsize + 128);
  BasicIO.OpenInput (inFile, fileName);
  BasicIO.Read (inFile, TextBuff, fsize, cRead);
  IF  CARDINAL (cRead) # fsize  THEN  Abort (2)  END;
  MemPools.NewPool (DataPool);
  LastRec := NIL;
  offset := 0;
  fields := 0;
  records := 0
END Init;


PROCEDURE ShutDown;

BEGIN
  MemPools.KillPool (TextPool);
  InOut.WriteLn;
  InOut.WriteString ("Data pools destroyed, files closed, shutting down.");
  InOut.WriteLn
END ShutDown;


BEGIN
  Init;
  GetFields (Fields);
  IF  fields = MaxFieldNum  THEN  Abort (3)  END;
  ShowFields (Fields);
  REPEAT
    Done := GetRecord (Record);
    StoreRecord (Record)
  UNTIL NOT Done;
  InOut.WriteString ("Records in memory");	InOut.WriteLn;
  InOut.WriteString ("Records processed : ");
  InOut.WriteCard (records, 1);			InOut.WriteLn;
  ShutDown
END klim05.
   
You can download klim05.mod in the download section.

Klim08

Late 2015 I took up work on the klim programs again. After Klim06, 07 Klim08 came. Compared to klim05 (see above), klim08 now adds:


Below is the source for Klim08.mod:
MODULE klim08;

(*     vers	does extra								date
       ----	------------------------------------------------------------------	-----------
	07	can process old and new data and make summaries				Nov 15, '15
	08	make klim produce better output files
		hide the dummy record
		create seperate lists for yearly and monthly summaries
		improve linked list (skip the dummy record)				Jan 3, '16
		fields to process, read from file, or defaulting			Jan 9, '16
	*)

IMPORT	SYSTEM, ASCII, Arguments, InOut, Strings, BasicIO, MemPools, TextIO, MathLib;

CONST	MaxBuff		= 20 * 1024 * 1024;
	MaxFieldNum	= 42;
	MaxFieldLen	= 16;
	NaN		= MIN (INTEGER) + 1;		(* NaN = Not a Number *)

TYPE	ChPOINTER	= POINTER TO ARRAY [0 .. MaxBuff] OF CHAR;
	FreqTab		= ARRAY [0 .. 99] OF CARDINAL;
	Field		= ARRAY [0 .. MaxFieldLen - 1] OF CHAR;
	DataStore	= ARRAY [0 .. MaxFieldNum - 1] OF INTEGER;
	FieldsStore	= ARRAY [0 .. MaxFieldNum - 1] OF Field;

	SummPtr		= POINTER TO SummNode;
	SummNode	= RECORD
			    station,
			    year, month,
			    fldnr, samples	: INTEGER;
			    sumx, sumxsq	: REAL;
			    next 		: SummPtr
			  END;
	DataPtr		= POINTER TO DataNode;
	DataNode	= RECORD
			    store	: DataStore;
			    next	: DataPtr
			  END;
	FreqPtr		= POINTER TO FreqNode;
	FreqNode	= RECORD
			    year	: INTEGER;
			    table	: FreqTab;
			    next	: FreqPtr
			  END;


VAR	records, fields,
	i, j, offset, fsize	: CARDINAL;
	lastChar		: CHAR;
	EOF, Done		: BOOLEAN;
	inFile, outFile		: BasicIO.File;
	fileName, fileBase	: Strings.String;
	TextPool, DataPool,
	SummPool		: MemPools.MemPool;
	TextBuff		: ChPOINTER;
	Record			: DataStore;
	LastRec, FirstRec	: DataPtr;
	FirstYY, FirstMM	: SummPtr;
	Fields			: FieldsStore;
	ScaleFactor		: ARRAY [0 .. MaxFieldNum - 1] OF REAL;
	
(*	If ScaleFactor [i] = 0.0, the field is excluded from the summaries;
	Else, value := integer x ScaleFactor [i]				*)


PROCEDURE DumpAllRx;

VAR	out	: TextIO.File;
	this	: DataPtr;
	fname	: Strings.String;

BEGIN
  this := FirstRec;
  fname := fileBase;
  Strings.Append (fname, ".rex");
  TextIO.OpenOutput (out, fname);
  IF  TextIO.Done () = FALSE  THEN  Abort (4)  END;
  REPEAT
    TextIO.PutInt (out, this^.store [0], 5);		(* stn *)
    TextIO.PutInt (out, this^.store [1], 11);		(* date *)
    TextIO.PutInt (out, this^.store [11], 8);		(* avg temp *)
    TextIO.PutLn (out);
    this := this^.next
  UNTIL this = NIL;
  TextIO.Close (out)
END DumpAllRx;


PROCEDURE W84Key (key : CHAR);

VAR	ch	: CHAR;

BEGIN
  REPEAT  InOut.Read (ch)  UNTIL  ch = key
END W84Key;


PROCEDURE Mark;

BEGIN
  InOut.Write ('.');
  InOut.WriteBf
END Mark;


PROCEDURE Abort (nr : CARDINAL);

BEGIN
  CASE  nr  OF
    1 :	InOut.WriteString ("Out of memory")		|
    2 : InOut.WriteString ("Error while reading file")	|
    3 : InOut.WriteString ("Too many fields found") 	|
    4 : InOut.WriteString ("Cannot open dump file")
  END;
  InOut.WriteString (", aborting.");	InOut.WriteLn;
  ShutDown;
  HALT
END Abort;


PROCEDURE Read (VAR chr : CHAR);

BEGIN
  chr := TextBuff^ [offset];
  IF  offset < fsize - 1  THEN
    INC (offset);
    EOF := FALSE
  ELSE
    chr := 0C;
    EOF := TRUE
  END;
  lastChar := chr
END Read;


PROCEDURE UnRead;

BEGIN
  IF  offset > 0  THEN  DEC (offset)  END
END UnRead;


PROCEDURE SkipWs;

VAR	ch	: CHAR;

BEGIN
  REPEAT  Read (ch)  UNTIL  (ch > ' ') OR EOF;
  UnRead
END SkipWs;


PROCEDURE SkipTo (token : CHAR);

VAR	ch	: CHAR;

BEGIN
  REPEAT  Read (ch)  UNTIL  (ch = token) OR EOF
END SkipTo;


PROCEDURE ReadInt (VAR  num  : INTEGER);

VAR	i, sign		: INTEGER;
	ch		: CHAR;

BEGIN
  sign := 1;		num := 0;
  Read (ch);
  WHILE  ch = ' '  DO  Read (ch)  END;
  IF  ch = '-'  THEN
    sign := -1;
    Read (ch)
  ELSIF  ch = ','  THEN
    num := NaN;
    RETURN
  ELSIF  (ch = ASCII.cr) OR (ch = ASCII.lf)   THEN
    num := NaN;
    RETURN
  END;
  LOOP
    IF  EOF  THEN  EXIT  END;
    IF  (ch < '0') OR (ch > '9')  THEN  
      num := NaN;
      REPEAT  Read (ch)  UNTIL  (ch = ',') OR (ch = ASCII.lf);
      RETURN
    END; 
    i := ORD (ch) - ORD ('0');
    num := 10 * num + i;
    Read (ch);
    IF  (ch = ',')  OR (ch = ASCII.cr) OR (ch = ASCII.lf)  THEN  EXIT  END;
  END;
  num := num * sign
END ReadInt;


PROCEDURE Sigma (sx, sx2 : REAL; n : INTEGER) : REAL;

VAR	sig, ma	: REAL;

BEGIN
  sig := sx2 * MathLib.real (n) - sx * sx;
  ma := MathLib.real (n * (n - 1));
  RETURN MathLib.sqrt (sig / ma)
END Sigma;


PROCEDURE FileSize (FileName : Strings.String) : CARDINAL;

CONST	Chunk		= 1024;

VAR	n, size		: CARDINAL;
	m		: INTEGER;
	inF		: BasicIO.File;
	tmpPool		: MemPools.MemPool;
	tmpPtr		: POINTER TO CHAR;

BEGIN
  n := 0;	m := 0;
  BasicIO.OpenInput (inF, FileName);
  IF  NOT BasicIO.DONE  THEN  RETURN 0  END;
  MemPools.NewPool (tmpPool);
  MemPools.PoolAllocate (tmpPool, tmpPtr, Chunk);
  REPEAT
    BasicIO.Read (inF, tmpPtr, Chunk, m);
    INC (n, Chunk)
  UNTIL m # Chunk;
  DEC (n, Chunk);
  size := n + CARDINAL (m);
  MemPools.KillPool (tmpPool);
  BasicIO.Close (inF);
  RETURN size
END FileSize;


PROCEDURE GetRecord (VAR  rec  : DataStore) : BOOLEAN;

VAR	i	: CARDINAL;
	res	: BOOLEAN;
	ch	: CHAR;

BEGIN
  i := 0;	res := FALSE;
  SkipTo (' ');
  REPEAT
    ReadInt (rec [i]);
    INC (i)
  UNTIL  EOF OR (i = fields);
  IF  NOT EOF  THEN  
    INC (records);
    res := TRUE
  END;
  RETURN res
END GetRecord;


PROCEDURE StoreRecord (VAR rec  : DataStore);

VAR	new	: DataPtr;

BEGIN
  MemPools.PoolAllocate (DataPool, new, SYSTEM.TSIZE (DataNode));
  IF  new = NIL  THEN  Abort (1)  END;
  WITH  new^  DO
    store := rec;		(* Bulk copy records	*)
    next  := NIL		(* Initialize pointer	*)
  END;
  IF  LastRec = NIL  THEN	(* Is this the first record?		*)
    FirstRec := new		(* If so, keep it's address		*)
  ELSE
    LastRec^.next := new	(* If not, make a linked list		*)
  END;
  LastRec := new		(* Remember last record's address	*)
END StoreRecord;


PROCEDURE ShowRecord (rec : DataStore);

VAR	i	: CARDINAL;

BEGIN
  i := 0;
  REPEAT
    (* 
    InOut.WriteString (Fields [i]);	InOut.Write (ASCII.ht); InOut.WriteString ("= ");
    *)
    IF  rec [i] = NaN  THEN
      InOut.WriteString ("NaN")
    ELSE
      InOut.WriteInt (rec [i], 1)
    END;
    IF  (i = 0) OR (i MOD 6 # 0)  THEN  InOut.Write (ASCII.ht)  ELSE  InOut.WriteLn  END;
    INC (i)
  UNTIL i = fields;
  InOut.WriteLn;	InOut.WriteLn
END ShowRecord;


PROCEDURE DumpRecord (x : CARDINAL);

VAR	this	: DataPtr;
	i	: CARDINAL;

BEGIN
  this := FirstRec;
  i := 1;
  WHILE  (i < x) AND (this^.next # NIL)  DO
    this := this^.next;
    INC (i)
  END;
  ShowRecord (this^.store)
END DumpRecord;


PROCEDURE GetField (VAR str : Field);

VAR	ch	: CHAR;
	n	: CARDINAL;

BEGIN
  n := 0;
  REPEAT  Read (ch)  UNTIL  (ch > ' ') OR EOF;
  REPEAT
    str [n] := ch;
    INC (n);
    Read (ch)
  UNTIL (ch = ',') OR (ch < ' ') OR (n = HIGH (str)) OR EOF;
  IF  n < HIGH (str)  THEN  
    str [n] := 0C
  ELSE
    SkipTo (',')
  END
END GetField;


PROCEDURE GetFields (VAR store : FieldsStore);

VAR	i	: CARDINAL;
	name	: Field;

BEGIN
  SkipTo ("#");			(* FieldsList starts with a '#'	*)
  i := 0;
  REPEAT
    GetField (name);
    store [i] := name;
    INC (fields);
    INC (i);
    IF  fields = MaxFieldNum  THEN  RETURN  END
  UNTIL  lastChar < ' ';		(* EOL is end of fields definition	*)
  SkipTo (' ')
END GetFields;


PROCEDURE ShowFields (store : FieldsStore);

VAR	i	: CARDINAL;

BEGIN
  InOut.WriteLn;
  InOut.WriteString ("Fields = ");	InOut.WriteCard (fields, 3);	InOut.WriteLn;
  FOR  i := 0  TO  fields - 1  DO
    InOut.WriteCard (i, 3);
    InOut.WriteString (" : ");		InOut.WriteString (store [i]);
    IF  i MOD 5 # 0  THEN
      InOut.Write (ASCII.ht)
    ELSE
      InOut.WriteLn
    END
  END;
  InOut.WriteLn
END ShowFields;


PROCEDURE NewSummNode (yy, mm, fd : INTEGER) : SummPtr;

VAR	new	: SummPtr;

BEGIN
  MemPools.PoolAllocate (SummPool, new, SYSTEM.TSIZE (SummNode));
  IF  new = NIL  THEN  Abort (1)  END;
  WITH  new^  DO
    month   := mm;
    year    := yy;
    fldnr   := fd;
    next    := NIL;
    sumx    := 0.0;
    sumxsq  := 0.0;
    samples := 0
  END;
  RETURN new
END NewSummNode;


PROCEDURE FindSnode (yy, mm, fd : INTEGER) : SummPtr;

VAR	this, prev, new	: SummPtr;

BEGIN
  IF  mm = 0  THEN  this := FirstYY  ELSE  this := FirstMM  END;
  prev := NIL;			(* To handle first record *)
  WHILE  this # NIL  DO
    IF  (this^.month = mm) AND (this^.year = yy) AND (this^.fldnr = fd)  THEN
      RETURN this
    ELSE
      prev := this;
      this := this^.next
    END
  END;
  new := NewSummNode (yy, mm, fd);
  IF  prev = NIL  THEN
    IF  mm = 0  THEN  FirstYY := new  ELSE  FirstMM := new  END
  ELSE
    prev^.next := new
  END;
  RETURN new
END FindSnode;


PROCEDURE Summarize (firstRec : DataPtr);

VAR	this		: DataPtr;
	that		: SummPtr;
	j, k		: CARDINAL;
	i, x,
	year, month	: INTEGER;
	rx		: REAL;

BEGIN
  this := firstRec;
  k := 0;
  REPEAT
    i := this^.store [1];	(* get date *)
    year := i DIV 10000;
    month := (i DIV 100) MOD 100;
    FOR  j := 2 TO fields - 1  DO
      IF  ScaleFactor [j] # 0.0  THEN
	x := this^.store [j];
	rx := MathLib.real (x) * ScaleFactor [j];
	IF  x # NaN  THEN
	  that := FindSnode (year, 0, j);	(* get yearly node	*)
	  WITH  that^  DO
	    INC (that^.samples);
	    station := this^.store [0];
	    sumx := sumx + rx;
	    sumxsq := sumxsq + rx * rx
	  END;
	  that := FindSnode (year, month, j);	(* get monthly node	*)
	  WITH  that^  DO
	    INC (samples);
	    station := this^.store [0];
	    sumx := sumx + rx;
	    sumxsq := sumxsq + rx * rx
	  END
	END
      END
    END;
    this := this^.next;
    INC (k)
  UNTIL  this = NIL;
  InOut.WriteString ("Summaries : "); InOut.WriteCard (k, 1); InOut.WriteLn;
END Summarize;


PROCEDURE DumpSumm (first : SummPtr; type : ARRAY OF CHAR);

VAR	out	: TextIO.File;
	this	: SummPtr;
	fname	: Strings.String;

BEGIN
  fname := fileBase;
  this := first;
  Strings.Append (fname, type);
  TextIO.OpenOutput (out, fname);
  IF  TextIO.Done () = FALSE  THEN  Abort (4)  END;
  TextIO.PutString (out, "#  stn   yy    mm    field      n     avg     std        sx        sqx");
  TextIO.PutLn (out);
  REPEAT
    TextIO.PutInt (out, this^.station, 6);
    TextIO.PutInt (out, this^.year, 6);
    TextIO.PutInt (out, this^.month, 5);
    TextIO.PutInt (out, this^.fldnr, 5);	TextIO.PutChar (out, ' ');
    TextIO.PutString (out, Fields [this^.fldnr]);
    IF  this^.fldnr # 2  THEN  
      TextIO.PutString (out, "   ")
    END;
    TextIO.PutInt (out, this^.samples, 5);
    IF  this^.samples > 1  THEN
      TextIO.PutReal (out, this^.sumx / MathLib.real (this^.samples), 8, 1);
      TextIO.PutReal (out, Sigma (this^.sumx, this^.sumxsq, this^.samples), 8, 1)
    ELSE
      TextIO.PutString (out, "                ")
    END;
    TextIO.PutString (out, "  ");
    TextIO.PutReal (out, this^.sumx, 10, 1);
    TextIO.PutString (out, "   ");
    TextIO.PutReal (out, this^.sumxsq, 15, 2);
    TextIO.PutLn (out);
    TextIO.PutBf (out);
    this := this^.next
  UNTIL this = NIL;
  TextIO.Close (out)
END DumpSumm;


PROCEDURE RdSfax (src : ARRAY OF CHAR) : BOOLEAN;

VAR	inf	: TextIO.File;
	ch	: CHAR;
	n	: CARDINAL;
	v	: REAL;

BEGIN
  TextIO.OpenInput (inf, src);
  IF  NOT TextIO.Done ()  THEN  RETURN FALSE  END;
  LOOP
    TextIO.GetChar (inf, ch);
    IF  ch = '#'  THEN
      REPEAT  TextIO.GetChar (inf, ch)  UNTIL  (ch = ASCII.LF) OR TextIO.EOF (inf)
    ELSE
      TextIO.GetCard (inf, n);
      IF TextIO.EOF (inf)  THEN  EXIT  END;
      IF  NOT TextIO.Done ()  THEN  RETURN FALSE  END;
      REPEAT  TextIO.GetChar (inf, ch)  UNTIL  ch = ':';
      TextIO.GetReal (inf, v);
      IF  NOT TextIO.Done ()  THEN  RETURN FALSE  END;
      ScaleFactor [n] := v;
      InOut.WriteString ("SF ");
      InOut.WriteCard (n, 2);
      InOut.WriteString (" = ");
      InOut.WriteReal (v, 5, 2);
      InOut.WriteLn;
      REPEAT  TextIO.GetChar (inf, ch)  UNTIL  ch = ASCII.LF
    END
  END;  
  TextIO.Close (inf);
  RETURN TRUE
END RdSfax;


PROCEDURE Init;

VAR	count		: SHORTCARD;
	cRead, t	: INTEGER;
	i		: CARDINAL;
	option		: Strings.String;
	buffer		: Arguments.ArgTable;

BEGIN
  Arguments.GetArgs (count, buffer);
  IF  count = 1  THEN
    InOut.WriteString ("Please specify a file to read");
    InOut.WriteLn;
    HALT
  END;
  Strings.Assign (fileName, buffer^ [1]^);
  i := Strings.pos ('.', fileName);
  Strings.Copy (fileName, 0, i, fileBase);
  fsize := FileSize (fileName);
  IF  fsize = 0  THEN
    InOut.WriteString ("Empty file; aborting.");	InOut.WriteLn;
    HALT
  END;
  InOut.WriteString ('Opened file "');			InOut.WriteString (fileName);
  InOut.WriteString ('" (');				InOut.WriteCard (fsize, 2);
  InOut.WriteString (" bytes). Buffering data.");	InOut.WriteLn;
  MemPools.NewPool (TextPool);
  MemPools.PoolAllocate (TextPool, TextBuff, fsize + 128);
  BasicIO.OpenInput (inFile, fileName);
  BasicIO.Read (inFile, TextBuff, fsize, cRead);
  IF  CARDINAL (cRead) # fsize  THEN  Abort (2)  END;
  MemPools.NewPool (DataPool);
  MemPools.NewPool (SummPool);
  LastRec := NIL;
  FirstYY := NIL;
  FirstMM := NIL;
  FOR  t := 0 TO MaxFieldNum - 1  DO
    ScaleFactor [t] := 0.0
  END;
  IF  RdSfax ("fields.rc") = FALSE  THEN
    ScaleFactor [ 2] := 1.0;	(* DDVector	*)
    ScaleFactor [ 4] := 0.1;	(* Avg Windspd	*)
    ScaleFactor [11] := 0.1;	(* Avg Temp	*)
    ScaleFactor [14] := 0.1;	(* Max Temp	*)
    ScaleFactor [21] := 0.1;	(* Rain time	*)
    ScaleFactor [22] := 0.1;	(* Rain quant	*)
    ScaleFactor [25] := 0.1;	(* Avg press	*)
  END;
  offset := 0;
  fields := 0;
  records := 0
END Init;


PROCEDURE ShutDown;

BEGIN
  MemPools.KillPool (TextPool);
  MemPools.KillPool (DataPool);
  MemPools.KillPool (SummPool);
  InOut.WriteLn;
  InOut.WriteString ("Data pools destroyed, files closed, shutting down.");
  InOut.WriteLn
END ShutDown;


BEGIN
  Init;
  GetFields (Fields);
  IF  fields = MaxFieldNum  THEN  Abort (3)  END;
  ShowFields (Fields); 
  WHILE  GetRecord (Record) = TRUE  DO
    StoreRecord (Record)
  END;
  InOut.WriteString ("Records in memory");	InOut.WriteLn;
  InOut.WriteString ("Records processed : ");
  InOut.WriteCard (records, 1);			InOut.WriteLn;
  Summarize (FirstRec);
  DumpSumm (FirstYY, ".ann");
  DumpSumm (FirstMM, ".mon");
(*
  DumpAllRx;
*)
  ShutDown
END klim08.
   
You can download the file from here: klim08.mod with Shift-LeftClick

Page created April 15, 2012 and