home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / BCUCOF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.8 KB  |  53 lines
  1. PROCEDURE bcucof(y,y1,y2,y12: gl4array; d1,d2: real; VAR c: gl4by4);
  2. (* Programs using routine BCUCOF must define the types
  3. TYPE
  4.    gl4array = ARRAY [1..4] OF real;
  5.    gl4by4 = ARRAY [1..4,1..4] OF real;
  6. in the main routine. They must also declare the variables
  7. VAR
  8.    glflag: boolean;
  9.    wt: ARRAY [1..16,1..16] OF real;
  10. and initialize glflag to true. The values of wt are read from the file
  11. bcucof.dat whose contents are listed at the end of this routine. The procedure
  12. GLOPEN assigns bcucof.dat to infile and opens the file for reading. *)
  13. VAR
  14.    l,k,j,i: integer;
  15.    xx,d1d2: real;
  16.    cl,x: ARRAY[1..16] OF real;
  17.    infile: text;
  18. BEGIN
  19.    IF glflag THEN BEGIN
  20.       glflag := FALSE;
  21.       glopen(infile,'bcucof.dat');
  22.       FOR i := 1 TO 16 DO FOR k := 1 TO 16 DO read(infile,wt[k,i]);
  23.       close(infile)
  24.    END;
  25.    d1d2 := d1*d2;
  26.    FOR i := 1 TO 4 DO BEGIN
  27.       x[i] := y[i];
  28.       x[i+4] := y1[i]*d1;
  29.       x[i+8] := y2[i]*d2;
  30.       x[i+12] := y12[i]*d1d2
  31.    END;
  32.    FOR i := 1 TO 16 DO BEGIN
  33.       xx := 0.0;
  34.       FOR k := 1 TO 16 DO xx := xx+wt[i,k]*x[k];
  35.       cl[i] := xx
  36.    END;
  37.    l := 0;
  38.    FOR i := 1 TO 4 DO
  39.       FOR j := 1 TO 4 DO BEGIN
  40.           l := l+1;
  41.           c[i,j] := cl[l]
  42.       END
  43. END;
  44. (* Contents of the file bcucof.dat
  45. 1 0 -3 2 0 0 0 0 -3 0 9 -6 2 0 -6 4 0 0 0 0 0 0 0 0 3 0 -9 6 -2 0 6 -4
  46. 0 0 0 0 0 0 0 0 0 0 9 -6 0 0 -6 4 0 0 3 -2 0 0 0 0 0 0 -9 6 0 0 6 -4
  47. 0 0 0 0 1 0 -3 2 -2 0 6 -4 1 0 -3 2 0 0 0 0 0 0 0 0 -1 0 3 -2 1 0 -3 2
  48. 0 0 0 0 0 0 0 0 0 0 -3 2 0 0 3 -2 0 0 0 0 0 0 3 -2 0 0 -6 4 0 0 3 -2
  49. 0 1 -2 1 0 0 0 0 0 -3 6 -3 0 2 -4 2 0 0 0 0 0 0 0 0 0 3 -6 3 0 -2 4 -2
  50. 0 0 0 0 0 0 0 0 0 0 -3 3 0 0 2 -2 0 0 -1 1 0 0 0 0 0 0 3 -3 0 0 -2 2
  51. 0 0 0 0 0 1 -2 1 0 -2 4 -2 0 1 -2 1 0 0 0 0 0 0 0 0 0 -1 2 -1 0 1 -2 1
  52. 0 0 0 0 0 0 0 0 0 0 1 -1 0 0 -1 1 0 0 0 0 0 0 -1 1 0 0 2 -2 0 0 -1 1 *)
  53.