Unit    FcstUtil;

{------------------------------------------------------------------------------
  Written by John Hufnagel on March 16 1995
  Modified by Tim Hunter on March 20, 1995 (and later)

  Unit to be used by Tim Hunter for back end of forecasting package interface
  under Borland's Delphi.
------------------------------------------------------------------------------}
INTERFACE

uses   SysUtils, Dialogs, MyDates;


function  GetLakeName ( var LakeName : String )       : Boolean;
function  GetNumSubs  ( var Subs : integer )          : Boolean;
function  GetPrgDesc  ( var PrgD : integer )          : Boolean;
function  GetOverLakeCode ( var OTLP : String )       : Boolean;

function  SetPrgDesc (PrgD : integer) : Boolean;

function  GetHistStartDateStr ( var DateStr : String ) : Boolean;
function  GetHistEndDateStr   ( var DateStr : String ) : Boolean;
function  GetBaseDateStr      ( var DateStr : String ) : Boolean;
function  GetProvEndDateStr   ( var DateStr : String ) : Boolean;
function  GetSimEndDateStr    ( var DateStr : String ) : Boolean;
function  GetFcstStartDateStr ( var DateStr : String ) : Boolean;
function  GetFcstEndDateStr   ( var DateStr : String ) : Boolean;
function  GetHistStartDate ( var HSDate : TMyDate )  : Boolean;
function  GetHistEndDate   ( var HEDate : TMyDate )  : Boolean;
function  GetBaseDate      ( var BDate : TMyDate )   : Boolean;
function  GetProvEndDate   ( var PEDate : TMyDate )  : Boolean;
function  GetSimEndDate    ( var SEDate : TMyDate )  : Boolean;
function  GetFcstStartDate ( var FSDate : TMyDate )  : Boolean;
function  GetFcstEndDate   ( var FEDate : TMyDate )  : Boolean;

function  GetNumberOfFullWeeks   (Start, Finish : longint) : longint;
function  GetNumberOfFullQtrMons (Start, Finish : longint) : longint;
function  GetNumberOfFullMonths  (Start, Finish : longint) : longint;
function  GetNumberOfFullYears   (Start, Finish : longint) : longint;

function  GetNumQtrMonthOtlks (Start, Finish : longint) : longint;
function  GetNumMonthlyOtlks  (Start, Finish : longint) : longint;
function  GetNumYearlyOtlks   (Start, Finish : longint) : longint;

function  GetQtrMonthNumber   (SeqNum:longint) : longint;
function  GetQtrMonthStartDay (Year, Month, Qtr : longint) : longint;
function  GetQtrMonthEndDay   (Year, Month, Qtr : longint) : longint;
function  GetNumDaysInQtrMon  (Year, Month, Qtr : longint) : longint;
procedure IncrementQtrMonth   (var Year, Month, Qtr : longint);
procedure DecrementQtrMonth   (var Year, Month, Qtr : longint);
procedure GetQtrMonthBounds(Year, Month : longint; var Qtr : array of integer);

procedure IncrementMonth (var Year, Month : longint);
procedure DecrementMonth (var Year, Month : longint);


// The procedure ComputeDateLimits(), which is normally included in this unit
// has been removed in this version (for Runoff Model Calibration) so that
// we wouldn't need the ViewType unit, thus we don't need Arrays unit.
// The procedure wasn't needed for this application anyway, and it just meant
// a lot of extra "baggage".  Tim Hunter  Nov 4, 1999.


IMPLEMENTATION

(******************************************************************************
*   This function simply opens the BSNNM file and reads the first line into   *
* the variable LakeName.  If successful it returns a TRUE else a FALSE.       *
******************************************************************************)
function GetLakeName ( var LakeName : String ) : Boolean;
var
  Ch     : char;
  S, Dir : string;
  Fin : file of char;
  I   : integer;
begin
  GetDir(0, Dir);

  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
      GetLakeName := FALSE;
      exit;
  end;

  AssignFile( Fin, 'BSNNM.');
  Reset( Fin );
  Seek( Fin, 0 );
  S := '';
  for I := 1 to 11 do begin
     Read( Fin, Ch);
     S := S + Ch;
  end;
  LakeName := S;
  CloseFile( Fin );
  GetLakeName := TRUE;
end;


(******************************************************************************
*   This function simply opens the BSNNM file and reads the number of         *
*  subbasins into the variable LakeName.  If successful it returns a TRUE     *
*  else a FALSE.                                                              *
******************************************************************************)
function GetNumSubs ( var Subs : integer ) : Boolean;
var
  Ch     : char;
  S, Dir, Tmp : string;
  Fin    : file of char;
  I, Err : integer;
begin
  GetDir(0, Dir);

  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
      GetNumSubs := FALSE;
      exit;
  end;

  AssignFile( Fin, 'BSNNM.');
  Reset( Fin );
  Seek( Fin, 12 );
  S := '';
  for I := 1 to 3 do begin
    Read( Fin, Ch);
    S := S + Ch;
  end;
  CloseFile( Fin );

  Tmp := copy(S, 2, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetNumSubs := False;
     exit;
  end;
  Subs := I;
  GetNumSubs := TRUE;
end;


(******************************************************************************
*  This function simply opens the BSNNM file and reads the program descriptor *
*  into the variable PrgD.  If successful it returns a TRUE else a FALSE.     *
******************************************************************************)
function SetPrgDesc (PrgD : integer) : Boolean;
var
  Buff    : array [1..999] of char;
  Fin, F2 : file of char;
  I, L    : integer;
  S, Dir  : string;
begin
  GetDir(0, Dir);

  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
      SetPrgDesc := FALSE;
      exit;
  end;

  AssignFile( Fin, 'BSNNM.');
  Reset( Fin );
  L := 1;
  while (not eof(Fin)) do begin
     Read(Fin, Buff[L]);
     L := L + 1;
  end;
  L := L - 1;     // L is total number of bytes
  CloseFile(Fin);


  Str(PrgD:3, S);     // remember, S is a long string, so index is 0..n
  Buff[16] := S[1];
  Buff[17] := S[2];
  Buff[18] := S[3];

  //
  // Write the entire output file in one fell swoop.
  //
  AssignFile(F2, 'BSNNM');
  try
     Rewrite(F2);
  except
     CloseFile(F2);
     Result := FALSE;
     exit;
  end;
  for I:=1 to L do Write(F2, Buff[I]);
  CloseFile(F2);

  SetPrgDesc := TRUE;
end;


(******************************************************************************
*   This function simply opens the BSNNM file and reads the 4-char code for   *
* overlake precipitation into the variable OTLP.                              *
* If successful it returns a TRUE else a FALSE.                               *
******************************************************************************)
function GetOverLakeCode ( var OTLP : String ) : Boolean;
var
  S, Dir : string;
  Ch  : char;
  Fin : file of char;
  I   : integer;
begin
  GetDir(0, Dir);

  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
     GetOverLakeCode := FALSE;
     exit;
  end;

  AssignFile( Fin, 'BSNNM.');
  Reset( Fin );
  Seek( Fin, 18 );
  OTLP := '';
  for I := 0 to 3 do begin
     Read( Fin, Ch);
     OTLP := OTLP + Ch;
  end;
  CloseFile( Fin );
  GetOverLakeCode := TRUE;
end;


(******************************************************************************
*  This function opens the BSNNM file and updates the program descriptor with *
*  the value of PrgD.  If successful it returns a TRUE else a FALSE.          *
******************************************************************************)
function GetPrgDesc ( var PrgD : integer ) : Boolean;
var
  Ch     : char;
  S, Dir, Tmp : string;
  Fin    : file of char;
  I, Err : integer;
begin
  GetDir(0, Dir);

  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
      GetPrgDesc := FALSE;
      exit;
  end;

  AssignFile( Fin, 'BSNNM.');
  Reset( Fin );
  Seek( Fin, 15 );
  S := '';
  for I := 1 to 3 do begin
    Read( Fin, Ch);
    S := S + Ch;
  end;
  CloseFile( Fin );

  Tmp := copy(S, 2, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetPrgDesc := False;
     exit;
  end;
  PrgD := I;
  GetPrgDesc := TRUE;
end;




(******************************************************************************
*   This function opens the xxx00.CLM file and reads the start date.          *
*  If successful it returns a TRUE else a FALSE.                              *
******************************************************************************)
function GetHistStartDate ( var HSDate : TMyDate ) : Boolean;
type
    CLMType = array[0..5] of byte;
var
  I : integer;
  SeqNum : longint;
  S, Dir, Bsn, CName  : string;
  Ch   : char;
  Buff : CLMType;
  Fin  : file of char;
  FCLM : file of CLMType;
begin
  GetDir(0, Dir);

  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
     GetHistStartDate := FALSE;
     exit;
  end;

  AssignFile( Fin, S);
  Reset( Fin );
  Bsn := '';
  for I:= 1 to 3 do begin
     Read( Fin, Ch );
     Bsn := Bsn + Ch;
  end;
  CloseFile( Fin );

  CName := Bsn + '00.CLM';
  S := FileSearch(CName, Dir);
  if Length(S) = 0 then begin
     GetHistStartDate := FALSE;
     exit;
  end;
  AssignFile( FCLM, S );
  Reset( FCLM );
  Read( FCLM, Buff );
  SeqNum := longint((@Buff[2])^);
  CloseFile( FCLM );
  HSDate.SetSeq(SeqNum);
  Result := TRUE;
end;

(******************************************************************************
*   This function opens the xxx00.CLM file and reads the end date.            *
*  If successful it returns a TRUE else a FALSE.                              *
******************************************************************************)
function GetHistEndDate ( var HEDate : TMyDate ) : Boolean;
type
    CLMType = array[0..5] of byte;
var
  I : integer;
  SeqNum : longint;
  S, Dir, Bsn, CName  : string;
  Ch   : char;
  Buff : CLMType;
  Fin  : file of char;
  FCLM : file of CLMType;
begin
  GetDir(0, Dir);
  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
     GetHistEndDate := FALSE;
     exit;
  end;
  AssignFile( Fin, S);
  Reset( Fin );
  Bsn := '';
  for I:= 1 to 3 do begin
     Read( Fin, Ch);
     Bsn := Bsn + Ch;
  end;
  CloseFile( Fin );

  CName := Bsn + '00.CLM';
  S := FileSearch(CName, Dir);
  if Length(S) = 0 then begin
     GetHistEndDate := FALSE;
     exit;
  end;
  AssignFile( FCLM, S );
  Reset( FCLM );
  Seek( FCLM, 1 );
  Read( FCLM, Buff );
  SeqNum := longint((@Buff[0])^);
  CloseFile( FCLM );
  HEDate.SetSeq(SeqNum);
  Result := TRUE;
end;

(******************************************************************************
*   This function simply opens the BSNNM file and reads the third line then   *
*  converts the text into a DATE variable assigned to the parameter BDate.    *
*  If successful it returns a TRUE else a FALSE.                              *
******************************************************************************)
function GetBaseDate ( var BDate : TMyDate ) : Boolean;
var
  Day, Month, Year: longint;
  S, Dir, Tmp, DateStr  : string;
  Ch  : char;
  Fin : file of char;
  I, Err   : integer;
begin
  GetDir(0, Dir);
  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
     GetBaseDate := FALSE;
     exit;
  end;
  AssignFile( Fin, S);
  Reset( Fin );
  Seek( Fin, 25 );
  DateStr := '';
  for I:= 1 to 11 do begin
     Read( Fin, Ch);
     DateStr := DateStr + Ch;
  end;
  CloseFile( Fin );

{ now convert to numeric }
  Tmp := copy(DateStr, 1, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetBaseDate := False;
     exit;
  end;
  Day := I;
  Tmp := copy(DateStr, 4, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetBaseDate := False;
     exit;
  end;
  Month := I;
  Tmp := copy(DateStr, 7, 4);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetBaseDate := False;
     exit;
  end;
  Year := I;

  Result := False;
  if (Day>0) and (Month>0) and (Year>0) then begin
      BDate.SetDay(Day, Month, Year);
      Result := TRUE;
  end;
end;

(******************************************************************************
*   This function simply opens the BSNNM file and reads the fourth line then  *
*  converts the text into a DATE variable assigned to the parameter PEDate.   *
*  If successful it returns a TRUE else a FALSE.                              *
******************************************************************************)
function GetProvEndDate ( var PEDate : TMyDate ) : Boolean;
var
  Day, Month, Year: longint;
  S, Dir, Tmp, DateStr  : string;
  Ch  : char;
  Fin : file of char;
  I, Err   : integer;
begin
  GetDir(0, Dir);
  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
     GetProvEndDate := FALSE;
     exit;
  end;
  AssignFile( Fin, S);
  Reset( Fin );
  Seek( Fin, 37 );
  DateStr := '';
  for I:= 1 to 11 do begin
     Read( Fin, Ch);
     DateStr := DateStr + Ch;
  end;
  CloseFile( Fin );

{ now convert to numeric }
  Tmp := copy(DateStr, 1, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
      GetProvEndDate := False;
      exit;
  end;
  Day := I;
  Tmp := copy(DateStr, 4, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetProvEndDate := False;
     exit;
  end;
  Month := I;
  Tmp := copy(DateStr, 7, 4);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetProvEndDate := False;
     exit;
  end;
  Year := I;

  GetProvEndDate := False;
  if (Day>0) and (Month>0) and (Year>0) then begin
     PEDate.SetDay(Day, Month, Year);
     GetProvEndDate := TRUE;
  end;

end;

(*****************************************************************************
*   This function will read the fifth line of the BSNNM file and set the     *
* SimEndDate to the day before that date.                                    *
*****************************************************************************)
function GetSimEndDate ( var SEDate : TMyDate ) : Boolean;
begin
  Result := FALSE;
  if GetFcstStartDate( SEDate ) then begin
     SEDate.SetSeq(SEDate.SeqNum-1);
     Result := TRUE;
  end;
end;


(*****************************************************************************
*   This function will read the fifth line of the BSNNM file and set the     *
* FcstStartDate to that date.                                                *
*****************************************************************************)
function GetFcstStartDate ( var FSDate : TMyDate ) : Boolean;
var
  Day, Month, Year: longint;
  S, Dir, Tmp, DateStr  : string;
  Ch  : char;
  Fin : file of char;
  I, Err   : integer;
begin
  GetDir(0, Dir);
  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
     GetFcstStartDate := FALSE;
     exit;
  end;
  AssignFile( Fin, S);
  Reset( Fin );
  Seek( Fin, 49 );
  DateStr := '';
  for i:= 1 to 11 do begin
     Read( Fin, Ch);
     DateStr := DateStr + Ch;
  end;
  CloseFile( Fin );

{ now convert to numeric }
  Tmp := copy(DateStr, 1, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetFcstStartDate := False;
     exit;
  end;
  Day := I;
  Tmp := copy(DateStr, 4, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetFcstStartDate := False;
     exit;
  end;
  Month := I;
  Tmp := copy(DateStr, 7, 4);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetFcstStartDate := False;
     exit;
  end;
  Year := I;

  GetFcstStartDate := False;
  if (Day>0) and (Month>0) and (Year>0) then begin
     FSDate.SetDay(Day, Month, Year);
     GetFcstStartDate := TRUE;
  end;

end;


(******************************************************************************
*   This function simply opens the BSNNM file and reads the sixth line into   *
* the variable FEDate.  If successful it returns a TRUE else a FALSE.         *
******************************************************************************)
function GetFcstEndDate ( var FEDate : TMyDate ) : Boolean;
var
  Day, Month, Year     : longint;
  S, Dir, Tmp, DateStr : string;
  Ch  : char;
  Fin : file of char;
  I, Err   : integer;
begin
  GetDir(0, Dir);
  S := FileSearch('BSNNM.', Dir);
  if Length(S) = 0 then begin
     GetFcstEndDate := FALSE;
     exit;
  end;

  AssignFile( Fin, 'BSNNM.');
  Reset( Fin );
  Seek( Fin, 61 );

  DateStr := '';
  for I:= 1 to 11 do begin
     Read( Fin, Ch );
     DateStr := DateStr + Ch;
  end;
  CloseFile(Fin);

{ now convert to numeric }
  Tmp := copy(DateStr, 1, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetFcstEndDate := FALSE;
     exit;
  end;
  Day := I;
  Tmp := copy(DateStr, 4, 2);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetFcstEndDate := FALSE;
     exit;
  end;
  Month := I;
  Tmp := copy(DateStr, 7, 4);
  Val(Tmp, I, Err);
  if not (Err=0) then begin
     GetFcstEndDate := FALSE;
     exit;
  end;
  Year := I;

  GetFcstEndDate := FALSE;
  if (Day>0) and (Month>0) and (Year>0) then begin
     FEDate.SetDay(Day, Month, Year);
     GetFcstEndDate := TRUE;
  end;

end;


(*****************************************************************************
*   This function will read the header for xxx00.CLM and set                 *
*   HistStartDateStr to the string for the starting date.                    *
*****************************************************************************)
function GetHistStartDateStr ( var DateStr : String ) : Boolean;
var
   TD : TMyDate;
begin
   TD := TMyDate.Create;
   if not GetHistStartDate(TD) then begin
      TD.Free;
      Result := FALSE;
      exit;
   end;
   DateStr := DateToString(TD);
   TD.Free;
   Result := TRUE;
end;

(*****************************************************************************
*   This function will read the header for xxx00.CLM and set                 *
*   HistEndDateStr to the string for the ending date.                        *
*****************************************************************************)
function GetHistEndDateStr ( var DateStr : String ) : Boolean;
var
   TD : TMyDate;
begin
   TD := TMyDate.Create;
   if not GetHistEndDate(TD) then begin
      TD.Free;
      Result := FALSE;
      exit;
   end;
   DateStr := DateToString(TD);
   TD.Free;
   Result := TRUE;
end;

(*****************************************************************************
*   This function will read the third line of the BSNNM file and set the     *
*   BaseDateStr to the string for that date.                                 *
*****************************************************************************)
function GetBaseDateStr ( var DateStr : String ) : Boolean;
var
   TD : TMyDate;
begin
   TD := TMyDate.Create;
   if not GetBaseDate(TD) then begin
      TD.Free;
      Result := FALSE;
      exit;
   end;
   DateStr := DateToString(TD);
   TD.Free;
   Result := TRUE;
end;

(*****************************************************************************
*   This function will read the fourth line of the BSNNM file and set the    *
* PrvEndDateStr to the string for that date.                                 *
*****************************************************************************)
function GetProvEndDateStr ( var DateStr : String ) : Boolean;
var
   TD : TMyDate;
begin
   TD := TMyDate.Create;
   if not GetProvEndDate(TD) then begin
      TD.Free;
      Result := FALSE;
      exit;
   end;
   DateStr := DateToString(TD);
   TD.Free;
   Result := TRUE;
end;

(*****************************************************************************
*   This function will read the fifth line of the BSNNM file and set the     *
* SimEndDateStr to the string for the day before that date.                  *
*****************************************************************************)
function GetSimEndDateStr ( var DateStr : String ) : Boolean;
var
   TD : TMyDate;
begin
   TD := TMyDate.Create;
   if not GetSimEndDate(TD) then begin
      TD.Free;
      Result := FALSE;
      exit;
   end;
   DateStr := DateToString(TD);
   TD.Free;
   Result := TRUE;
end;

(*****************************************************************************
*   This function will read the fifth line of the BSNNM file and set the     *
*   FcstStartDateStr to the string for that date.                            *
*****************************************************************************)
function GetFcstStartDateStr ( var DateStr : String ) : Boolean;
var
   TD : TMyDate;
begin
   TD := TMyDate.Create;
   if not GetFcstStartDate(TD) then begin
      TD.Free;
      Result := FALSE;
      exit;
   end;
   DateStr := DateToString(TD);
   TD.Free;
   Result := TRUE;
end;

(*****************************************************************************
*   This function will read the sixth line of the BSNNM file and set the     *
*   FcstEndDateStr to the string for that date.                              *
*****************************************************************************)
function GetFcstEndDateStr ( var DateStr : String ) : Boolean;
var
   TD : TMyDate;
begin
   TD := TMyDate.Create;
   if not GetFcstEndDate(TD) then begin
      TD.Free;
      Result := FALSE;
      exit;
   end;
   DateStr := DateToString(TD);
   TD.Free;
   Result := TRUE;
end;

(******************************************************************************
* GetQtrMonthNumber determines which quarter-month we are in.                 *
******************************************************************************)
function GetQtrMonthNumber (SeqNum : longint) : longint;
var
   I, Q : longint;
   EndOfQtr : array [0..3] of integer;
   TD : TMyDate;
begin
   TD := TMyDate.Create;
   TD.SetSeq(SeqNum);
   GetQtrMonthBounds(TD.Year, TD.Month, EndOfQtr);
   Q := 1;
   for I := 0 to 2 do
      if TD.Day > EndOfQtr[I] then Q := I + 2;
   TD.Free;
   Result := Q;
end;

(******************************************************************************
* GetQtrMonthStartDay returns the first day of the Qtr-Month specified.       *
******************************************************************************)
function GetQtrMonthStartDay (Year, Month, Qtr : longint) : longint;
var
   EndOfQtr : array [0..3] of integer;
begin
   GetQtrMonthBounds(Year, Month, EndOfQtr);
   if Qtr = 1 then begin
      Result := 1;
      exit;
   end;
   Result := EndOfQtr[Qtr-2] + 1;
end;

(******************************************************************************
* GetQtrMonthEndDay returns the last day of the Qtr-Month specified.          *
******************************************************************************)
function GetQtrMonthEndDay (Year, Month, Qtr : longint) : longint;
var
   EndOfQtr : array [0..3] of integer;
begin
   GetQtrMonthBounds(Year, Month, EndOfQtr);
   Result := EndOfQtr[Qtr-1];
end;

(******************************************************************************
* GetNumDaysInQtrMon returns the number of days of the Qtr-Month specified.   *
******************************************************************************)
function GetNumDaysInQtrMon (Year, Month, Qtr : longint) : longint;
var
  D1, D2 : longint;
begin
  D1 := GetQtrMonthStartDay(Year, Month, Qtr);
  D2 := GetQtrMonthEndDay(Year, Month, Qtr);
  Result := D2 - D1 + 1;
end;

(******************************************************************************
* IncrementQtrMonth increments the quarter month designator.                  *
******************************************************************************)
procedure IncrementQtrMonth (var Year, Month, Qtr : longint);
begin
   Qtr := Qtr + 1;
   if (Qtr > 4) then begin
      Qtr := Qtr - 4;
      Month := Month + 1;
      if (Month > 12) then begin
         Month := Month - 12;
         Year := Year + 1;
      end;
   end;
end;

(******************************************************************************
* DecrementQtrMonth decrements the quarter month designator.                  *
******************************************************************************)
procedure DecrementQtrMonth (var Year, Month, Qtr : longint);
begin
   Qtr := Qtr - 1;
   if (Qtr < 1) then begin
      Qtr := Qtr + 4;
      Month := Month - 1;
      if (Month < 1) then begin
         Month := Month + 12;
         Year := Year - 1;
      end;
   end;
end;

(******************************************************************************
* GetQtrMonthBounds determines the last day of each quarter-month based on    *
* the definitions received from USACE - Buffalo.                              *
******************************************************************************)
procedure GetQtrMonthBounds(Year, Month : longint; var Qtr : array of integer);
var
   Days : longint;
begin
   Days := DaysInMonth(Year, Month);
   case Days of
     28  :  begin
                Qtr[0] := 7;
                Qtr[1] := 14;
                Qtr[2] := 21;
                Qtr[3] := 28;
            end;
     29  :  begin
                Qtr[0] := 7;
                Qtr[1] := 14;
                Qtr[2] := 21;
                Qtr[3] := 29;
            end;
     30  :  begin
                Qtr[0] := 8;
                Qtr[1] := 15;
                Qtr[2] := 23;
                Qtr[3] := 30;
            end;
     31  :  begin
                Qtr[0] := 8;
                Qtr[1] := 15;
                Qtr[2] := 23;
                Qtr[3] := 31;
            end;
   end;
end;

(******************************************************************************
*  GetNumberOfFullWeeks returns the number of complete 7-day weeks within     *
*  the specified period.                                                      *
******************************************************************************)
function GetNumberOfFullWeeks(Start, Finish : longint) : longint;
begin
   Result := (Finish - Start + 1) div 7;
end;


(******************************************************************************
*  GetNumberOfFullQtrMons returns the number of complete quarter-months       *
*  within the specified period.                                               *
******************************************************************************)
function GetNumberOfFullQtrMons(Start, Finish : longint) : longint;
var
   QtrInMon1, QtrInMon2 : integer;
   Mon1, Mon2, Year1, Year2, FullMonths : longint;
   TD1, TD2    : TMyDate;
   Qtr1, Qtr2  : array [0..3] of integer;
begin
   TD1 := TMyDate.Create;
   TD2 := TMyDate.Create;

   TD1.SetSeq(Start);
   TD2.SetSeq(Finish);

   GetQtrMonthBounds(TD1.Year, TD1.Month, Qtr1);
   GetQtrMonthBounds(TD2.Year, TD2.Month, Qtr2);

   { How many complete qtr-months are there in the start month? }
   QtrInMon1 := 4;
   if (TD1.Day <> 1) then begin
      QtrInMon1 := 3;
      if (TD1.Day > Qtr1[0]+1) then QtrInMon1 := 2;
      if (TD1.Day > Qtr1[1]+1) then QtrInMon1 := 1;
      if (TD1.Day > Qtr1[2]+1) then QtrInMon1 := 0;
   end;

   { How many complete qtr-months are there in the finish month? }
   QtrInMon2 := 4;
   if (TD2.Day < Qtr2[3]) then QtrInMon2 := 3;
   if (TD2.Day < Qtr2[2]) then QtrInMon2 := 2;
   if (TD2.Day < Qtr2[1]) then QtrInMon2 := 1;
   if (TD2.Day < Qtr2[0]) then QtrInMon2 := 0;

   { round start/end months to next month forward/backward respectively }
   Mon1  := TD1.Month+1;
   Year1 := TD1.Year;
   if (Mon1 = 13) then begin
      Mon1  := 1;
      Year1 := Year1 + 1;
   end;

   Mon2  := TD2.Month-1;
   Year2 := TD2.Year;
   if (Mon2 = 0) then begin
      Mon2  := 12;
      Year2 := Year2 - 1;
   end;

   TD1.Free;
   TD2.Free;

   FullMonths := (Year2-Year1)*12 + (Mon2-Mon1) + 1;
   Result := QtrInMon1 + FullMonths*4 + QtrInMon2;
end;

(******************************************************************************
*  GetNumberOfFullMonths returns the number of complete months (1-nn) within  *
*  the specified period.                                                      *
******************************************************************************)
function GetNumberOfFullMonths(Start, Finish : longint) : longint;
var
   Mon1, Mon2, Year1, Year2 : longint;
   TD1, TD2, TD3 : TMyDate;
begin
   TD1 := TMyDate.Create;
   TD2 := TMyDate.Create;
   TD3 := TMyDate.Create;

   TD1.SetSeq(Start);
   TD2.SetSeq(Finish);
   TD3.SetSeq(Finish+1);

   if (TD1.Day = 1) then begin
      Mon1  := TD1.Month;
      Year1 := TD1.Year;
   end
   else begin
      Mon1  := TD1.Month+1;
      Year1 := TD1.Year;
      if (Mon1 = 13) then begin
         Mon1  := 1;
         Year1 := Year1 + 1;
      end;
   end;

   if (TD3.Day = 1) then begin
      Mon2  := TD2.Month;
      Year2 := TD2.Year;
   end
   else begin
      Mon2  := TD2.Month-1;
      Year2 := TD2.Year;
      if (Mon2 = 0) then begin
         Mon2  := 12;
         Year2 := Year2 - 1;
      end;
   end;

   TD1.Free;
   TD2.Free;
   TD3.Free;
   Result := (Year2-Year1)*12 + (Mon2-Mon1) + 1;
end;

(******************************************************************************
*  GetNumberOfFullYears returns the number of complete calendar years within  *
*  the specified period.  These years must run from January 1 to December 31. *
******************************************************************************)
function GetNumberOfFullYears(Start, Finish : longint) : longint;
var
   Year1, Year2 : longint;
   TD1, TD2 : TMyDate;
begin
   TD1 := TMyDate.Create;
   TD2 := TMyDate.Create;
   TD1.SetSeq(Start);
   TD2.SetSeq(Finish);

   if ((TD1.Day = 1) and (TD1.Month = 1)) then Year1 := TD1.Year
   else  Year1 := TD1.Year+1;

   if ((TD2.Day = 31) and (TD2.Month = 12)) then Year2 := TD2.Year
   else  Year2 := TD2.Year-1;

   TD1.Free;
   TD2.Free;

   Result := Year2 - Year1 + 1;
end;


(******************************************************************************
*  GetNumQtrMonthOtlks returns the number of outlook quarter-months within    *
*  the specified period.                                                      *
******************************************************************************)
function GetNumQtrMonthOtlks(Start, Finish : longint) : longint;
var
   QBounds  : array [0..3] of integer;
   I, Parts, SDay, SMonth, SYear : longint;
begin
   SequenceDate(SDay, SMonth, SYear, Start);
   GetQtrMonthBounds(SYear, SMonth, QBounds);
   Parts := 1;
   if (SDay = 1) then Parts := 0;
   for I := 0 to 2 do
      if (SDay = QBounds[I]+1) then Parts := 0;
   Result := GetNumberOfFullQtrMons(Start, Finish) + Parts;
end;


(******************************************************************************
*  GetNumMonthlyOtlks returns the number of outlook months within             *
*  the specified period.                                                      *
******************************************************************************)
function GetNumMonthlyOtlks(Start, Finish : longint) : longint;
var
  Parts, SDay, SMonth, SYear : longint;
begin
   SequenceDate(SDay, SMonth, SYear, Start);
   Parts := 0;
   if (SDay <> 1) then Parts := 1;
   Result := GetNumberOfFullMonths(Start, Finish) + Parts;
end;

(******************************************************************************
*  GetNumYearlyOtlks returns the number of outlook years within               *
*  the specified period.                                                      *
******************************************************************************)
function GetNumYearlyOtlks(Start, Finish : longint) : longint;
var
  Parts, SDay, SMonth, SYear : longint;
  EDay, EMonth, EYear        : longint;
begin
   SequenceDate(SDay, SMonth, SYear, Start);
   SequenceDate(EDay, EMonth, EYear, Finish+1);
   Parts := EYear - SYear;
   Result := GetNumberOfFullYears(Start, Finish) + Parts;
end;


(******************************************************************************
*  IncrementMonth increments the month (and year, if needed).                 *
******************************************************************************)
procedure IncrementMonth(var Year, Month : longint);
var
  M2, Y2 : longint;
begin
   M2 := Month + 1;
   Y2 := Year;
   while (M2 > 12) do begin
      M2 := M2 - 12;
      Y2 := Y2 + 1;
   end;
   Month := M2;
   Year  := Y2;
end;

(******************************************************************************
*  DecrementMonth decrements the month (and year, if needed).                 *
******************************************************************************)
procedure DecrementMonth(var Year, Month : longint);
var
  M2, Y2 : longint;
begin
   M2 := Month - 1;
   Y2 := Year;
   while (M2 < 1) do begin
      M2 := M2 + 12;
      Y2 := Y2 - 1;
   end;
   Month := M2;
   Year  := Y2;
end;

INITIALIZATION

END.
