home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / CPMGR.ZIP / CPMGR.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  9.3 KB  |  308 lines
  1. (*-------------------------------------------------------------------*)
  2. (*                                                                   *)
  3. (*  Critical Path Method Project Scheduler - 18 Sept 83 - E. Dong    *)
  4. (*  Based on BASIC version, 'Hard Hat Management: Two On-Site        *)
  5. (*  Tools', by Richard Parry, INTERFACE AGE, February, 1981.         *)
  6. (*                                                                   *)
  7. (*  Translated into CIC86 'C' by Edward V. Dong                      *)
  8. (*  Retranslated into Turbo Pascal by E.V. Dong                      *)
  9. (*                                         Last Update: 24-Mar-84    *)
  10. (*-------------------------------------------------------------------*)
  11.  
  12. const
  13.   SIZE = 100;
  14.  
  15. var
  16.   i, j, k, m, NumOfJobs: integer;       (* Internal Integer Parms    *)
  17.   instring: string[80];
  18.   filein, fileout: text;                (* 'Standard' file definition*)
  19.  
  20.   c1, c2, du, l1, m1, m2, PathLen: integer;
  21.   cp, sd, StartTime, From, d: array [1..SIZE] of integer;
  22.   Earliest, LatestTime, Slack: array [1..SIZE] of integer;
  23.   JobName: array [1..SIZE] of string[9];     (* Job names *)
  24.  
  25. (* initialize arrays *)
  26. PROCEDURE InitCPM;
  27. var
  28.   icount : integer;
  29. begin
  30.   for icount := 1 to SIZE do
  31.       begin
  32.         StartTime[icount] := 0;
  33.         From[icount] := 0;
  34.         cp[icount] := 0;
  35.         d[icount] := 0;
  36.         Earliest[icount] := 0;
  37.         LatestTime[icount] := 0;
  38.         Slack[icount] := 0;
  39.         JobName[icount] := ' ';
  40.       end;
  41. end;
  42.  
  43. (* setup file I/O *)
  44. PROCEDURE InitFile;
  45. var
  46.   filename: string[20];
  47.   answer: char;
  48.   icount: integer;
  49.   filetype: array [1..2] of string[6];
  50. begin
  51.   filetype[1] := 'input';
  52.   filetype[2] := 'output';
  53.   for icount :=1 to 2 do
  54.     begin
  55.       write('Do you want ',filetype[icount],' at console? (Y/N): ');
  56.       readln(answer);
  57.       if (answer='Y') or (answer='y') then filename:='con:'
  58.       else
  59.         begin
  60.           write('Enter filename: '); readln(filename);
  61.         end;
  62.       case icount of
  63.          1: begin assign(filein,filename); reset(filein) end;
  64.          2: begin assign(fileout,filename); rewrite(fileout) end;
  65.       end;
  66.     end;
  67. end;
  68.  
  69. (* Sort Data Subroutine, Using Start Node as Key *)
  70. PROCEDURE PerformSort;
  71. var sw, temp: integer;
  72. BEGIN
  73. sw := 0;
  74. for i:=1 to NumOfJobs-1 do
  75.      BEGIN
  76.      j := i + 1;
  77.      if (StartTime[i] > StartTime[j]) then
  78.           BEGIN
  79.           temp := StartTime[i];
  80.                StartTime[i] := StartTime[j]; StartTime[j] := temp;
  81.           temp := From[i]; From[i] := From[j]; From[j] := temp;
  82.           temp := d[i]; d[i] := d[j]; d[j] := temp;
  83.           sw := 1;
  84.           END;
  85.      END;
  86. if sw = 1 then PerformSort;     (* sort again if needed *)
  87. END;
  88.  
  89. PROCEDURE DoCPM;
  90. label cpm_test, cpm_exit;
  91. BEGIN
  92. writeln('--> CPM ANALYSIS IN PROGRESS <--'); writeln;
  93.  
  94. (* compute earliest starting time *)
  95. c1 := 0; c2 := 0; PathLen := 0;
  96. for i:=1 to NumOfJobs do
  97.      BEGIN
  98.      m1 := Earliest[StartTime[i]] + d[i];
  99.      if (Earliest[From[i]] <= m1) then Earliest[From[i]] := m1;
  100.      END;
  101.  
  102. (* compute latest finishing time *)
  103. LatestTime[From[NumOfJobs]] := Earliest[From[NumOfJobs]];
  104. for i:=NumOfJobs downto 1 do
  105.      BEGIN
  106.      l1 := StartTime[i]; m2 := LatestTime[From[i]] - d[i];
  107.      if ((LatestTime[l1] >= m2) or (LatestTime[l1] = 0))
  108.           then LatestTime[l1] := m2;
  109.      END;
  110.  
  111. (* compute float time & critical path length *)
  112. for i:=1 to NumOfJobs do
  113.      BEGIN
  114.        Slack[i] := LatestTime[From[i]] - Earliest[StartTime[i]] - d[i];
  115.        if (Slack[i] = 0) then c1 := c1 + 1;
  116.        if (LatestTime[From[i]] > PathLen) then PathLen := LatestTime[From[i]];
  117.      END;
  118.  
  119. (* output results of CP analysis *)
  120. writeln(fileout);
  121. writeln(fileout,'CP Analysis is:');
  122. writeln(fileout,'   [EST   = Earliest Starting Time]');
  123. writeln(fileout,'   [LFT   = Latest  Finishing Time]');
  124. writeln(fileout,'   [SLACK = Float  or  Slack  Time]');
  125. writeln(fileout,'Name':9,'From':9,'To':9,'EST':9,'LFT':9,'SLACK':9);
  126. for i:=1 to NumOfJobs do
  127.      BEGIN
  128.      write(fileout,JobName[i]:9);
  129.      write(fileout,StartTime[i]:9,From[i]:9);
  130.      write(fileout,Earliest[StartTime[i]]:9);
  131.      writeln(fileout,LatestTime[From[i]]:9,Slack[i]:9);
  132.      END;
  133. writeln(fileout); writeln(fileout,'The Critical Path Length is ',PathLen);
  134.  
  135. (* compute critical path *)
  136. i := 0;
  137. while (From[i] <> 0) do i:=i+1;
  138. cpm_test:
  139.   c2 := c2 + 1; cp[i] := cp[i] + 1;
  140.   if (i > NumOfJobs) then goto cpm_exit;
  141. for m:=1 to NumOfJobs do
  142.     BEGIN
  143.        if (StartTime[m] <> From[i]) then goto cpm_exit
  144.        else if (Slack[m] <> 0) then goto cpm_exit
  145.             else
  146.                BEGIN
  147.                i:=m;
  148.                goto cpm_test;
  149.                END;
  150.     END;
  151. cpm_exit:
  152.   if (c1 <> c2) then du := du + 1;
  153. END;
  154.  
  155. (* Input Data Subroutine *)
  156. PROCEDURE GetData;
  157. var temp: integer;
  158. BEGIN
  159.      write('Jobname: ');
  160.      readln(filein,instring);JobName[i]:=instring;
  161.      write('From:':9);
  162.      readln(filein,temp); StartTime[i] := temp;
  163.      write('To:':9);
  164.      readln(filein,temp); From[i] := temp;
  165.      write('Duration:':9);
  166.      readln(filein,temp); d[i] := temp;
  167.      while (From[i] > NumOfJobs)
  168.           BEGIN
  169.           write(fileout,'For Jobname: ',instring);
  170.           write(fileout,' *** End Node # ',From[i]);
  171.           writeln(fileout,'Not =< # ',NumOfJobs,' of Activities ***');
  172.           write('To: ');
  173.           readln(filein,From[i]);
  174.           END;
  175.      if (StartTime[i] >= From[i]) then
  176.           BEGIN
  177.           write(fileout,'For Jobname: ',instring);
  178.           write(fileout,' *** Start Node ',StartTime[i]);
  179.           writeln(fileout,'Must Be < End Node ',From[i],' ***');writeln(fileout);
  180.           writeln(fileout,'*** Redo Entry ***');
  181.           GetData;
  182.           END;
  183. END;
  184.  
  185. (* critical path printout *)
  186. PROCEDURE DoCPL;
  187. var iname, jname: integer;
  188.  
  189. BEGIN
  190. iname := StartTime[i];
  191. jname := From[i];
  192. writeln(fileout,JobName[iname]:9,iname:9,JobName[jname]:9,jname:9);
  193. c2 := c2 + 1;
  194. if (i<=NumOfJobs) then
  195.      BEGIN
  196.      for m:=1 to NumOfJobs do
  197.           BEGIN
  198.           if ((StartTime[m]=From[i]) and (Slack[m]=0)) then
  199.                BEGIN
  200.                i := m;
  201.                DoCPL;
  202.                END;
  203.           END;
  204.      END;
  205. if (c1 <> c2) then writeln(fileout,'There is more than one critical path.');
  206. END;
  207.  
  208. (* generate GANTT chart *)
  209. PROCEDURE DoGANTT;
  210. var
  211.  linelen, scale, scale2: real;
  212.  limit, z1, z2, z3: integer;
  213.  symbol: char;
  214.  
  215. BEGIN
  216. writeln(fileout);
  217. writeln(fileout,'GANTT Chart for Project:'); writeln(fileout);
  218. writeln(fileout,'Non-critical path is denoted as ====');
  219. writeln(fileout,'    Critical path is denoted as ****');
  220. writeln(fileout,'   Slack (if any) is denoted as ....');
  221. writeln(fileout);
  222.  
  223. (* calculate chart scaling *)
  224. linelen := 60.0;
  225. scale := linelen/PathLen; scale2 := scale;
  226. z1 := trunc(scale);
  227. z2 := z1 - 1;
  228. z3 := 1;
  229. limit := 0;
  230. while limit <= 1 do
  231.      BEGIN
  232.      z3 := z3 * 10;
  233.      limit := trunc(z3 * scale)
  234.      END;
  235.  
  236. (* generate ruler line for chart *)
  237. write(fileout,'0':10);
  238. j := 0;
  239. while j < trunc(linelen) do
  240.    BEGIN
  241.      for k := 1 to limit-1 do write(fileout,'-');
  242.      write(fileout,'+');
  243.      j := j + limit
  244.    END;
  245. writeln(fileout);
  246.  
  247. (* generate GANTT waterfall *)
  248. for j:=1 to NumOfJobs do
  249.      BEGIN
  250.      write(fileout,JobName[j]:9);
  251.      limit := trunc(Earliest[StartTime[j]] * scale);
  252.      for k:=0 to limit do write(fileout,' ');
  253.      if (Slack[j]=0) then symbol := '*'
  254.           else  symbol := '=';
  255.      limit := trunc(LatestTime[From[j]] * scale) - limit;
  256.      for k:=0 to limit do write(fileout,symbol);
  257.      if (Slack[j]<>0) then
  258.         BEGIN
  259.         symbol := '.';
  260.         for k:=0 to trunc(Slack[j] * scale) do write(fileout,symbol);
  261.         END;
  262.      writeln(fileout);
  263.      END;
  264. END;
  265.  
  266. (* body of main portion of program==================================*)
  267.  
  268. BEGIN
  269. writeln('CPM: Project Scheduler'); writeln;   (* identify program *)
  270. InitFile;                                     (* setup file I/O *)
  271. writeln(fileout,'CPM: Project Scheduler');
  272. writeln(fileout);
  273.  
  274. (* initialize variables *)
  275. c1 := 0; c2 := 0; du := 0; m1 := 0; m2 := 0; PathLen := 0;
  276. InitCPM;                                      (* initialize arrays *)
  277.  
  278. (* get # of activities*)
  279. write('Enter number of events (activities): ');
  280. readln(filein,NumOfJobs);
  281.  
  282. (* input routine *)
  283. for i:=1 to NumOfJobs do
  284.      BEGIN
  285.      writeln('Event No. ',i); GetData; writeln;
  286.      END;
  287.  
  288. (* call sort routine *)
  289. writeln(fileout); writeln(fileout,'--> SORTING IN PROGRESS <--');
  290. PerformSort;
  291. (* display sort *)
  292. write(fileout,'Event No':9,'Name':9);
  293. writeln(fileout,'From':9,'To ':9,'Duration');
  294. for i:=1 to NumOfJobs do
  295.      BEGIN
  296. writeln(fileout,i:9,JobName[i]:9,StartTime[i]:9,From[i]:9,d[i]:9);
  297.      END;
  298.  
  299. DoCPM;                               (* do critical path analysis *)
  300. c2 := 0;
  301. writeln(fileout); writeln(fileout,'The Critical Path is:');
  302. writeln(fileout,'From',' ':18,'To');
  303. i:=1; while (Slack[i] <> 0) i:=i+1;  (* locate start of critical path *)
  304. DoCPL;                               (* critical path printout *)
  305. DoGANTT;                             (* display GANTT chart *)
  306. close(fileout);                      (* close & save output *)
  307. END.
  308.