/* Implements the Dot Product in PL/I.                               */
/* Copyright (c) by R. A. Vowels. Written 12 January 2004.           */
/* Uses an efficient algorithm for forming and summing the products. */
DECLARE DOT_PRODUCT GENERIC (
   DOT_PRODUCTCICI WHEN (FIXED BINARY COMPLEX, FIXED BINARY COMPLEX),
   DOT_PRODUCTCI   WHEN (FIXED BINARY COMPLEX, FIXED BINARY),
   DOT_PRODUCTII   WHEN (FIXED BINARY, FIXED BINARY),

   DOT_PRODUCTFI   WHEN (*, FIXED BINARY),
   DOT_PRODUCTIF   WHEN (FIXED BINARY, *),

   DOT_PRODUCTCC   WHEN (COMPLEX, COMPLEX),
   DOT_PRODUCTC    WHEN (COMPLEX, *),
   DOT_PRODUCTR    WHEN (*, *) );

DOT_PRODUCTII:
   PROCEDURE (V, W) RETURNS (FIXED BINARY (31));
      DECLARE (V, W) (*) FIXED BINARY (31) NONASSIGNABLE;
      DECLARE Total FIXED BINARY (31);
      DECLARE (I,J) FIXED BINARY (31);

      IF DIM (V) ^= DIM (W) THEN (SUBSCRIPTRANGE): SIGNAL SUBSCRIPTRANGE;

      Total = 0;
      J = LBOUND(W);
      DO I = LBOUND(V) TO HBOUND(V);
         Total = Total + V(I) * W(J);
         J = J + 1;
      END;
      RETURN (Total);
END DOT_PRODUCTII;

DOT_PRODUCTCI:
   PROCEDURE (V, W) RETURNS (FIXED BINARY (31) COMPLEX);
      DECLARE (V COMPLEX, W) (*) FIXED BINARY (31) NONASSIGNABLE;
      DECLARE Total FIXED BINARY (31) COMPLEX;
      DECLARE (I,J) FIXED BINARY (31);

      IF DIM (V) ^= DIM (W) THEN (SUBSCRIPTRANGE): SIGNAL SUBSCRIPTRANGE;

      Total = 0;
      J = LBOUND(W);
      DO I = LBOUND(V) TO HBOUND(V);
         Total = Total + CONJG(V(I)) * W(J);
         J = J + 1;
      END;
      RETURN (Total);

END DOT_PRODUCTCI;

DOT_PRODUCTCICI:
   PROCEDURE (V, W) RETURNS (FIXED BINARY (31) COMPLEX);
      DECLARE (V, W) (*) FIXED BINARY (31) COMPLEX NONASSIGNABLE;
      DECLARE Total FIXED BINARY (31) COMPLEX;
      DECLARE (I,J) FIXED BINARY (31);

      IF DIM (V) ^= DIM (W) THEN (SUBSCRIPTRANGE): SIGNAL SUBSCRIPTRANGE;

      Total = 0;
      J = LBOUND(W);
      DO I = LBOUND(V) TO HBOUND(V);
         Total = Total + CONJG(V(I)) * W(J);
         J = J + 1;
      END;
      RETURN (Total);

END DOT_PRODUCTCICI;

DOT_PRODUCTFI:
   PROCEDURE (V, W) RETURNS (FLOAT (18));
      DECLARE (V FLOAT (18), W FIXED BINARY (31)) (*) NONASSIGNABLE;
      DECLARE Total FLOAT (18);
      DECLARE (I,J) FIXED BINARY (31);

      IF DIM (V) ^= DIM (W) THEN (SUBSCRIPTRANGE): SIGNAL SUBSCRIPTRANGE;

      Total = 0;
      J = LBOUND(W);
      DO I = LBOUND(V) TO HBOUND(V);
         Total = Total + V(I) * W(J);
         J = J + 1;
      END;
      RETURN (Total);
END DOT_PRODUCTFI;

DOT_PRODUCTIF:
   PROCEDURE (V, W) RETURNS (FLOAT (18));
      DECLARE (V FIXED BINARY (31), W FLOAT (18)) (*) NONASSIGNABLE;
      DECLARE Total FLOAT (18);
      DECLARE (I,J) FIXED BINARY (31);

      IF DIM (V) ^= DIM (W) THEN (SUBSCRIPTRANGE): SIGNAL SUBSCRIPTRANGE;

      Total = 0;
      J = LBOUND(W);
      DO I = LBOUND(V) TO HBOUND(V);
         Total = Total + V(I) * W(J);
         J = J + 1;
      END;
      RETURN (Total);
END DOT_PRODUCTIF;

DOT_PRODUCTR:
   PROCEDURE (V, W) RETURNS (FLOAT (18));
      DECLARE (V, W) (*) FLOAT (18) NONASSIGNABLE;
      DECLARE Total FLOAT (18);
      DECLARE (I,J) FIXED BINARY (31);

      IF DIM (V) ^= DIM (W) THEN (SUBSCRIPTRANGE): SIGNAL SUBSCRIPTRANGE;

      Total = 0;
      J = LBOUND(W);
      DO I = LBOUND(V) TO HBOUND(V);
         Total = Total + V(I) * W(J);
         J = J + 1;
      END;
      RETURN (Total);
END DOT_PRODUCTR;

DOT_PRODUCTC:
   PROCEDURE (V, W) RETURNS (FLOAT (18) COMPLEX);
      DECLARE (V COMPLEX, W) (*) FLOAT (18) NONASSIGNABLE;
      DECLARE Total FLOAT (18) COMPLEX;
      DECLARE (I,J) FIXED BINARY (31);

      IF DIM (V) ^= DIM (W) THEN (SUBSCRIPTRANGE): SIGNAL SUBSCRIPTRANGE;

      Total = 0;
      J = LBOUND(W);
      DO I = LBOUND(V) TO HBOUND(V);
         Total = Total + CONJG(V(I)) * W(J);
         J = J + 1;
      END;
      RETURN (Total);

END DOT_PRODUCTC;

DOT_PRODUCTCC:
   PROCEDURE (V, W) RETURNS (FLOAT (18) COMPLEX);
      DECLARE (V, W) (*) FLOAT (18) COMPLEX NONASSIGNABLE;
      DECLARE Total FLOAT (18) COMPLEX;
      DECLARE (I,J) FIXED BINARY (31);

      IF DIM (V) ^= DIM (W) THEN (SUBSCRIPTRANGE): SIGNAL SUBSCRIPTRANGE;

      Total = 0;
      J = LBOUND(W);
      DO I = LBOUND(V) TO HBOUND(V);
         Total = Total + CONJG(V(I)) * W(J);
         J = J + 1;
      END;
      RETURN (Total);

END DOT_PRODUCTCC;