{ common code for cnm

  This file contains various definitions, type statements and
  procedures which are used throughout the collection of

          "Compact Numerical Methods".

  created by merging original files constype.def tdstamp.pas startup.pas
  and then adding extra utility functions
}

{constants ==
  In many cases not all definitions are needed, and users with very
  tight memory constraints may wish to remove some of the lines of this
  file when compiling certain programs.

          Copyright 1988 J.C.Nash
}

#define STRING(l) packed array[ 1 .. l ] of char

const
  big = 1.0E+35;    {a very large number}
  Maxconst = 25;    {Maximum number of constants in data record}
  Maxobs = 100;     {Maximum number of observations in data record}
  Maxparm  = 25;    {Maximum number of parameters to adjust}
  Maxvars = 10;     {Maximum number of variables in data record}
  acctol = 0.0001;  {acceptable point tolerance for minimisation codes}
  maxm = 20;        {Maximum number or rows in a matrix}
  maxn = 20;        {Maximum number of columns in a matrix}
  maxmn = 40;       {maxn+maxm, the number of rows in a working array}
  maxsym = 210;     {maximum number of elements of a symmetric matrix
              which need to be stored = maxm * (maxm + 1)/2 }
  reltest = 10.0;   {a relative size used to check equality of numbers.
              Numbers x and y are considered equal if the
              floating-point representation of reltest+x equals
              that of reltest+y.}
  stepredn = 0.2;   {factor to reduce stepsize in line search}

type
  rmatrix = array[1..maxm, 1..maxn] of real; {a real matrix}
  wmatrix = array[1..maxmn, 1..maxn] of real; {a working array, formed
                  as one real matrix stacked on another}
  smatvec = array[1..maxsym] of real; {a vector to store a symmetric matrix
              as the row-wise expansion of its lower triangle}
  rvector = array[1..maxm] of real;  {a real vector. We will use vectors
              of m elements always. While this is NOT space efficient,
              it simplifies program codes.}
  cgmethodtype= (Fletcher_Reeves,Polak_Ribiere,Beale_Sorenson);
    {three possible forms of the conjugate gradients updating formulae}
  probdata = record
          m     : integer; {number of observations}
          nvar  : integer; {number of variables}
          nconst: integer; {number of constants}
          vconst: array[1..Maxconst] of real;
          Ydata : array[1..Maxobs, 1..Maxvars] of real;
          nlls  : boolean; {true if problem is nonlinear least squares}
        end;
{
  NOTE: Pascal does not let us define the work-space for the function
  within the user-defined code.  This is a weakness of Pascal for this
  type of work.

  The following variables allow us to keep a copy of all screen
  information in a file for some of the codes.  Pascal requires a
  variable (confile in this case) for the file itself.  The string
  variable confname is used for the name of the file.  Similar variables
  allow problem data to be read from the file dfile named dfname.
}
type fileName = STRING(64);

var {global definitions}
  confile    : text;       {file for output of console image}
  confname   : fileName;   {a name for confile}
  dfile      : text;       {file for output of console image}
  dfname     : fileName;   {a name for confile}
  infile     : text;       {an input file (keyboard image)}
  infname    : fileName;   {a name for the input file}

  isConsole  : boolean;


procedure tdstamp(var outfile : text);
{tdstamp.pas == writes a time/date stamp to outfile

          rewritten for p5x

          Copyright 1988, 1990 J.C.Nash
}

var
   t   : timeStamp;
   ddd : STRING(3);

procedure leadzero( value: integer );
begin
   if value < 10 then
      write( outfile, '0', value:1)
   else
      write( outfile, value:2 );
end; {leadzero}

begin
   getTimeStamp(t);

   with t do begin
      case day_of_week of
        1 : ddd := 'Sun';
        2 : ddd := 'Mon';
        3 : ddd := 'Tue';
        4 : ddd := 'Wed';
        5 : ddd := 'Thu';
        6 : ddd := 'Fri';
        7 : ddd := 'Sat';
      end; {case}

      writeln( ddd, ' ', year, '-', month, '-', day, ' ',
               hour, ':', minute, ':', second );
      write( outfile, ddd, ' ', year:4, '-' );
      leadzero( month );
      write(outfile, '-');
      leadzero( day );
      write(outfile, ' ');
      leadzero( hour );
      write(outfile, ':');
      leadzero( minute );
      write(outfile, ':');
      leadzero( second );
   end;
  writeln( outfile );
end; {tdstamp}


{read string str from text file f, len = length of string}
procedure readString(var f   : text;
                     var str : packed array [one .. shi : integer] of char;
                     var len : integer);
var
   c    : char;
   i    : integer;
   done : boolean;
begin
   i := 0;
   done := false;
   while not eof(f) and not eoln(f) and not done do begin
      read(f, c);
      if i >= shi then
         done := true
      else if (c > ' ') or (i > 0) then begin {skip leading whitespace}
         i := i+1;
         str[i] := c;
      end;
   end; {while}
   len := i;
   for i := len+1 to shi do str[i] := ' ';
   if not eof(f) then
      readln(f);
end; { readString }


{ find value of real number from string }
procedure val( str     : packed array[one..shi : integer] of char;
               var x   : real;
               var err : integer );
var
   number, fracPart : real;
   pwr10, scale     : real;
   exp              : integer;
   i                : integer;
   neg, eneg        : boolean;
   ok               : boolean;
begin

   ok := false;
   i := 1;
   neg := false;

   while (i <= shi) and (str[i] <= ' ') do begin    {skip leading white space}
      i := i+1;
   end;

   if (i <= shi) and (str[i] in ['+','-']) then begin
      if str[i] = '-' then
         neg := true;
      i := i+1;
   end;

   number := 0;
   while (i <= shi) and (str[i] in ['0'..'9']) do begin
      {TODO: check for overflow}
      number := number*10 + ord(str[i]) - ord('0');
      i := i+1;
      ok := true; {we have a valid number}
   end;

   if (i <= shi) and (str[i] = '.') then begin
      {found a fractional part}
      i := i+1;
      fracPart := 0;
      scale := 1;
      while (i <= shi) and (str[i] in ['0'..'9']) do begin
         {TODO: check for overflow}
         fracPart := fracPart*10 + ord(str[i]) - ord('0');
         scale := scale*10;
         i := i+1;
         ok := true; {we have a valid number}
      end;
      number := number + fracPart / scale;
   end;

   if (i <= shi) and (str[i] in ['e','E']) then begin
      {found exponent}
      exp := 0;
      i := i+1;
      eneg := false;
      if (i <= shi) and (str[i] in ['+','-']) then begin
         if str[i] = '-' then
            eneg := true;
         i := i+1;
      end;
      while (i <= shi) and (str[i] in ['0'..'9']) do begin
         {TODO: check for overflow}
         exp := exp*10 + ord(str[i]) - ord('0');
         i := i+1;
      end;
      scale := 1;
      pwr10 := 10;
      while exp <> 0 do begin
         if odd(exp) then
            scale := scale * pwr10;
         pwr10 := sqr(pwr10);
         exp := exp div 2;
      end;
      if eneg then
         number := number / scale
      else
         number := number * scale;
   end;

   if neg then
      x := -number
   else
      x := number;

   if ok then
      err := 0
   else
      err := i;

end; { val }


procedure startup;
{startup -- startup code
            get control input file and console image file
            modified for p5x

          Copyright 1988, 1990 J.C.Nash
}
var
   li, lc :  integer;
begin
  writeln(banner);   {display the program banner}
  tdstamp( output ); {display a time and date stamp}

  {Get a filename for a file with data for running a problem.}
  write('File for input of control data ([cr] for keyboard) ');
  isConsole := false;
  readString(input, infname, li);
  if li {length(infname)} = 0 then isConsole := true;
  assign(infile, infname); reset(infile);  {Open this file}

  {Get a name for a file to which console output is repeated.}
  write('File for console image ([cr] = nul) ');
  readString(infile, confname, lc);
  if lc {length(confname)} = 0 then begin
     {confname := 'nul';}
     if not isConsole then writeln('nul');
  end
  else begin
     assign(confile, confname);
     if not isConsole then writeln(confname:lc{len(confname)});
  end;
  {Changes a carriage return to a 'nul' so console copy is omitted.}
  {Writes out the console file name on the screen if it comes from a file.
  Also moves to new line when reading from a file rather than keyboard.}
  rewrite(confile);
  {Opens to console image file.}
  writeln(confile,banner);
  tdstamp(confile); {Repeat banner and time stamp -- it is a little bit
    different from the console timestamp.}
  writeln(confile, 'File for input of control data ([cr] for keyboard) ',
          infname:li{len(infname)});
  writeln(confile, 'File for console image ([cr] = nul) ',
                   confname:lc{len(confname)});
  {Repeat the setup information to the console image file.}
  {Now start the program proper.}
end; {startup}

{ --------- end of common.inc.pas --------- }
