C
C      ________________________________________________________
C     |                                                        |
C     |    FACTOR A SYMMETRIC MATRIX WITH PARTIAL PIVOTING     |
C     |                                                        |
C     |    INPUT:                                              |
C     |                                                        |
C     |        A     --ARRAY PACKED WITH ELEMENTS CONTAINED IN |
C     |                EACH ROW OF COEFFICIENT MATRIX ON DIAG. |
C     |                AND TO RIGHT(LENGTH AT LEAST 7+(N+7)N/2)|
C     |                                                        |
C     |        N     --MATRIX DIMENSION                        |
C     |                                                        |
C     |    OUTPUT:                                             |
C     |                                                        |
C     |        A     --FACTORED MATRIX                         |
C     |                                                        |
C     |    BUILTIN FUNCTIONS: ABS                              |
C     |    PACKAGE SUBROUTINES: PFACT                          |
C     |________________________________________________________|
C
      SUBROUTINE IFACT(A,N)
      REAL A(1),R,S,T,U,V,W
      INTEGER B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q
      M = (N+N*N)/2
      L = M + N
      I = M
C     ------------------------
C     |*** COMPUTE 1-NORM ***|
C     ------------------------
10    I = I + 1
      A(I) = 0.
      IF ( I .LT. L ) GOTO 10
      I = -L
      J = M
      K = M
      R = 0.
      S = 0.
20    I = I + L - K
      K = K + 1
      J = K
      S = ABS(A(I+J))
30    IF ( J .EQ. L ) GOTO 40
      J = J + 1
      T = ABS(A(I+J))
      S = S + T
      A(J) = A(J) + T
      GOTO 30
40    S = S + A(K)
      IF ( R .LT. S ) R = S
      IF ( K .LT. L ) GOTO 20
      J = M + 3
C     -----------------------------------
C     |*** SHIFT MATRIX DOWN 3 SLOTS ***|
C     -----------------------------------
50    A(J) = A(J-3)
      J = J - 1
      IF ( J .GT. 3 ) GOTO 50
      A(1) = 1237
      A(2) = N
      A(3) = R
      IF ( N .GT. 1 ) GOTO 60
      A(9) = A(4)
      A(4) = 1235
      A(5) = 1
      A(6) = ABS(A(9))
      IF ( A(9) .NE. 0. ) RETURN
      A(1) = -1237
      A(4) = -1235
      RETURN
60    IF ( N .EQ. 2 ) GOTO 250
      E = 7 + (N*(N+5))/2
      H = N
      K = 4
70    G = H - 1
      D = N - G
      IF ( H .GT. 2 ) GOTO 80
      C = 0
      GOTO 150
80    L = K + G
      I = K + 1
      P = I
C     -------------------------
C     |*** DETERMINE PIVOT ***|
C     -------------------------
      DO 90 J = I,L
90         IF ( ABS(A(J)) .GT. ABS(A(P)) ) P = J
      S = A(P)
      A(E+D) = D + P - K
      C = P - I
      IF ( S .EQ. 0. ) GOTO 150
      IF ( C .EQ. 0 ) GOTO 130
      A(P) = A(I)
      A(I) = S
      I = K + H + 1
      L = I + C - 2
      P = L + G
      IF ( I .GT. L ) GOTO 110
C     ----------------------------------
C     |*** PERMUTE ROWS AND COLUMNS ***|
C     ----------------------------------
      O = G + I - 2
      DO 100 J = I,L
           T = A(J)
           A(J) = A(P)
           A(P) = T
100        P = P + O - J
110   J = K + H
      T = A(J)
      A(J) = A(P)
      A(P) = T
      I = L + 2
      L = K + G + G
      IF ( I .GT. L ) GOTO 130
      O = (C*(G+G-C-1))/2
      DO 120 J = I,L
           T = A(J)
           P = J + O
           A(J) = A(P)
120        A(P) = T
130   I = K + 2
      L = K + G
C     -----------------------------
C     |*** COMPUTE MULTIPLIERS ***|
C     -----------------------------
      DO 140 J = I,L
140        A(J) = A(J)/S
C     -----------------------------------
C     |*** EVALUATE DIAGONAL ELEMENT ***|
C     -----------------------------------
150   Q = K + G + G
      P = K + H + 1
      IF ( D .GT. 1 ) GOTO 160
      W = A(K+H)
      O = -G
      GOTO 210
160   M = N - 1
      V = A(K+H)
      T = 0.
      S = A(5)
      I = 4
      J = 4 + D + C
      U = A(J)
      L = N
      IF ( H .EQ. 2 ) GOTO 230
170   I = I + L
      R = A(J)
      B = J - C
      O = B - P + 1
      A(J) = A(B)
      A(B) = R
      J = J + M
      R = A(I+1)
      IF ( I .EQ. K ) GOTO 190
      W = S*T + U*A(I) + A(J)*R
      DO 180 F = P,Q
180        A(F) = A(F) - W*A(F+O)
      V = V - U*W
      S = R
      T = U
      U = A(J)
      L = M
      M = M - 1
      GOTO 170
190   W = S*T + U*A(I) + R
      DO 200 F = P,Q
200        A(F) = A(F) - W*A(F+O)
      W = V - U*W
      A(K+H) = W - U*R
      O = O + H
210   DO 220 F = P,Q
220        A(F) = A(F) - W*A(F+O)
      K = K + H
      H = H - 1
      GOTO 70
230   I = I + L
      J = J + M
      R = A(I+1)
      IF ( I .EQ. K ) GOTO 240
      W = S*T + U*A(I) + A(J)*R
      V = V - U*W
      S = R
      T = U
      U = A(J)
      L = M
      M = M - 1
      GOTO 230
240   W = S*T + U*A(I) + R
      V = V - U*W
      A(K+H) = V - U*R
C     ---------------------------
C     |*** REARRANGE STORAGE ***|
C     ---------------------------
250   I = 4
      K = 4
      H = N
      M = 5 + (N*(N+1))/2
260   A(M) = A(K)
      A(M+1) = A(K+1)
      IF ( H .EQ. 2 ) GOTO 280
      O = K - I + 2
      L = I - 3 + H
      DO 270 J = I,L
270        A(J) = A(J+O)
      I = L + 1
      K = K + H
      H = H - 1
      M = M + 2
      GOTO 260
280   M = M + 2
      A(M) = A(K+2)
      A(M+1) = 0.
      I = 6 + (N*(N+1))/2
      L = I + N + N - 2
      K = I - N - N - 1
      M = K
      DO 290 J = I,L,2
           A(K) = A(J)
           A(K+1) = A(J-1)
           A(K+2) = A(J)
290        K = K + 3
C     ---------------------------------------
C     |*** FACTOR THE TRIDIAGONAL MATRIX ***|
C     ---------------------------------------
      CALL PFACT(A(M),3,N)
      IF ( A(M) .LT. 0. ) A(1) = -1237
      RETURN
      END