home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / dada / crossth3.ltg next >
Text File  |  1986-02-27  |  2KB  |  75 lines

  1.  
  2.                            Listing 3.  
  3.          PPL code for concurrent matrix LU decomposition
  4.  
  5.  
  6. FUNCTION LU_Decomposition(VAR A : array[1..MAX,1..MAX] of real;
  7.                            N : integer) return boolean
  8. è-- Matrix A is converted into a L\U matrix
  9.  
  10. BEGIN
  11.    Priority = 1
  12.    INITIALIZE: Set first colum of L\U matrix = first column of matrix A
  13.    LOOP <Complete first row>
  14.    BEGIN For i = 2 to N
  15.       L\U[1,i] = A[1,i] / A[1,1]
  16.    END LOOP <Complete first row> 
  17.    TERMINATE: None
  18.  
  19.    INITIALIZE: i = 2; Found_Error = FASLE
  20.    LOOP <Set Column>
  21.    BEGIN IF (i > N) OR  Found_Error THEN EXIT <Set Column> END IF
  22.       L\U[i,i] = A[i,i] - (vector of all elements to the left of L\U[i,i]) 
  23.                         * (vector of all elements above L\U[i,i])
  24.       INITIALIZE: First = i
  25.       LOOP <Find Zero Diagonals>
  26.       BEGIN IF (L\U[First,i] <> 0) AND (NOT Found_Error)
  27.                THEN EXIT <Find Zero Diagonals> END IF
  28.                First += 1
  29.                IF First <= N THEN Calculate L\U[First,i] 
  30.                              ELSE Found_Error = TRUE
  31.       END LOOP <Find Zero Diagonals>  
  32.  
  33.       IF Found_Error THEN EXIT <Set column> END IF
  34.  
  35.       IF First <> i 
  36.          THEN Swap rows First and 'i' in matrices A & L\U END IF
  37.    
  38.       IF First < N 
  39.           THEN StartProcedure(Do_Column(i),Priority, ColSignal) END IF
  40.  
  41.       StartProcedure(Do_Row(i), Priority, RowSignal)
  42.       Wait_Signal(ColSignal); Wait_Signal(Row_Signal)
  43.    END LOOP 
  44.    TERMINATE: None
  45.    return ( Found_Errors )
  46. END LU_Decomposition
  47.  
  48.  
  49. PROCEDURE Do_Column(i : integer)
  50. -- procedure to calculate L\U column elements in the 'i'th column
  51.  
  52. BEGIN
  53.    INITIALIZE: 
  54.    LOOP 
  55.    BEGIN For j = i+1 to N
  56.       L\U[i,j] = A[i,j] - (vector of members L\U[1,i] to L\U[i-1,i]) 
  57.                         * (vector of members L\U[j,1] to L\U[j,i-1)
  58.    END LOOP 
  59.    TERMINATE: 
  60. END Do_Column
  61.  
  62. èPROCEDURE Do_Row(i : integer)
  63. -- procedure to calculate L\U row elements in the 'i'th row
  64.  
  65. BEGIN
  66.    INITIALIZE: 
  67.    LOOP 
  68.    BEGIN For j = i+1 to N
  69.       L\U[j,i] = A[j,i] - (vector of members L\U[1,i] to L\U[i-1,i]) 
  70.                         * (vector of members L\U[j,1] to L\U[j,i-1)
  71.       L\U[j,i] /= L\U[i,i] -- divide by diagonal element
  72.    END LOOP 
  73.    TERMINATE: 
  74. END Do_Row
  75.