home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / DOS / Programa / NUMANA01.ZIP / SRC / VEC.MOD < prev   
Encoding:
Modula Implementation  |  1996-08-15  |  5.1 KB  |  162 lines
  1. IMPLEMENTATION MODULE Vec;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*                 Vector arithmetic                    *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        15 August 1996                  *)
  9.         (*  Status:             Seems to be working             *)
  10.         (*                                                      *)
  11.         (*      Portability note: this module contains some     *)
  12.         (*      open array operations which are a language      *)
  13.         (*      extension in XDS Modula-2 but not part of       *)
  14.         (*      ISO standard Modula-2.  So far I haven't worked *)
  15.         (*      out how to do this in the standard language.    *)
  16.         (*                                                      *)
  17.         (********************************************************)
  18.  
  19. FROM Storage IMPORT
  20.     (* proc *)  ALLOCATE, DEALLOCATE;
  21.  
  22. FROM MiscM2 IMPORT
  23.     (* proc *)  WriteLn, WriteString, WriteLongReal;
  24.  
  25. (************************************************************************)
  26.  
  27. <* m2extensions+ *>
  28. <* storage+ *>
  29.  
  30. (************************************************************************)
  31. (*                  CREATING AND DESTROYING VECTORS                     *)
  32. (************************************************************************)
  33.  
  34. PROCEDURE NewVector (N: CARDINAL): VectorPtr;
  35.  
  36.     (* Creates a vector of N elements. *)
  37.  
  38.     VAR result: VectorPtr;
  39.  
  40.     BEGIN
  41.         NEW (result, N);
  42.         RETURN result;
  43.     END NewVector;
  44.  
  45. (************************************************************************)
  46.  
  47. PROCEDURE DisposeVector (VAR (*INOUT*) V: VectorPtr;  N: CARDINAL);
  48.  
  49.     (* Deallocates a vector of N elements. *)
  50.  
  51.     BEGIN
  52.         DISPOSE (V);
  53.     END DisposeVector;
  54.  
  55. (************************************************************************)
  56. (*                          COPYING A VECTOR                            *)
  57. (************************************************************************)
  58.  
  59. PROCEDURE Copy (A: ARRAY OF EltType;  N: CARDINAL;
  60.                          VAR (*OUT*) B: ARRAY OF EltType);
  61.  
  62.     (* Copies an N-element vector A to B. *)
  63.  
  64.     VAR i: CARDINAL;
  65.  
  66.     BEGIN
  67.         FOR i := 0 TO N-1 DO
  68.             B[i] := A[i];
  69.         END (*FOR*);
  70.     END Copy;
  71.  
  72. (************************************************************************)
  73. (*                          VECTOR ARITHMETIC                           *)
  74. (************************************************************************)
  75.  
  76. PROCEDURE Add (A, B: ARRAY OF EltType;  elts: CARDINAL;
  77.                       VAR (*OUT*) C: ARRAY OF EltType);
  78.  
  79.     (* Computes C := A + B.  All vectors have elts elements. *)
  80.  
  81.     VAR i: CARDINAL;
  82.  
  83.     BEGIN
  84.         FOR i := 0 TO elts-1 DO
  85.             C[i] := A[i] + B[i];
  86.         END (*FOR*);
  87.     END Add;
  88.  
  89. (************************************************************************)
  90.  
  91. PROCEDURE Sub (A, B: ARRAY OF EltType;  elts: CARDINAL;
  92.                       VAR (*OUT*) C: ARRAY OF EltType);
  93.  
  94.     (* Computes C := A - B.  All vectors have elts elements.  *)
  95.  
  96.     VAR i: CARDINAL;
  97.  
  98.     BEGIN
  99.         FOR i := 0 TO elts-1 DO
  100.             C[i] := A[i] - B[i];
  101.         END (*FOR*);
  102.     END Sub;
  103.  
  104. (************************************************************************)
  105.  
  106. PROCEDURE Mul (A: ARRAY OF ARRAY OF EltType;  B: ARRAY OF EltType;
  107.                       N1, N2: CARDINAL;
  108.                       VAR (*OUT*) C: ARRAY OF EltType);
  109.  
  110.     (* Computes C := A*B, where A is N1xN2 and B is N2x1. *)
  111.  
  112.     VAR i, j: CARDINAL;  sum: EltType;
  113.  
  114.     BEGIN
  115.         FOR i := 0 TO N1-1 DO
  116.             sum := 0.0;
  117.             FOR j := 0 TO N2-1 DO
  118.                 sum := sum + A[i,j]*B[j];
  119.             END (*FOR*);
  120.             C[i] := sum;
  121.         END (*FOR*);
  122.     END Mul;
  123.  
  124. (************************************************************************)
  125.  
  126. PROCEDURE ScalarMul (A: EltType;  B: ARRAY OF EltType;  elts: CARDINAL;
  127.                                   VAR (*OUT*) C: ARRAY OF EltType);
  128.  
  129.     (* Computes C := A*B, where A is scalar and B has elts elements. *)
  130.  
  131.     VAR i: CARDINAL;
  132.  
  133.     BEGIN
  134.         FOR i := 0 TO elts-1 DO
  135.             C[i] := A * B[i];
  136.         END (*FOR*);
  137.     END ScalarMul;
  138.  
  139. (************************************************************************)
  140. (*                              OUTPUT                                  *)
  141. (************************************************************************)
  142.  
  143. PROCEDURE Write (V: ARRAY OF EltType;  N: CARDINAL;  places: CARDINAL);
  144.  
  145.     (* Writes the N-element vector V to the screen, where each  *)
  146.     (* column occupies a field "places" characters wide.        *)
  147.  
  148.     VAR i: CARDINAL;
  149.  
  150.     BEGIN
  151.         FOR i := 0 TO N-1 DO
  152.             WriteString ("  ");
  153.             WriteLongReal (V[i], places-2);
  154.         END (*FOR*);
  155.         WriteLn;
  156.     END Write;
  157.  
  158. (************************************************************************)
  159.  
  160. END Vec.
  161.  
  162.