SUBROUTINE  S7IPR(P, IP, H)
C
C  APPLY THE PERMUTATION DEFINED BY IP TO THE ROWS AND COLUMNS OF THE
C  P X P SYMMETRIC MATRIX WHOSE LOWER TRIANGLE IS STORED COMPACTLY IN H.
C  THUS H.OUTPUT(I,J) = H.INPUT(IP(I), IP(J)).
C
      INTEGER P
      INTEGER IP(P)
      REAL H(1)
C
      INTEGER I, J, J1, JM, K, K1, KK, KM, KMJ, L, M
      REAL T
C
C ***  BODY  ***
C
      DO 90 I = 1, P
         J = IP(I)
         IF (J .EQ. I) GO TO 90
         IP(I) = IABS(J)
         IF (J .LT. 0) GO TO 90
         K = I
 10         J1 = J
            K1 = K
            IF (J .LE. K) GO TO 20
               J1 = K
               K1 = J
 20         KMJ = K1-J1
            L = J1-1
            JM = J1*L/2
            KM = K1*(K1-1)/2
            IF (L .LE. 0) GO TO 40
               DO 30 M = 1, L
                  JM = JM+1
                  T = H(JM)
                  KM = KM+1
                  H(JM) = H(KM)
                  H(KM) = T
 30               CONTINUE
 40         KM = KM+1
            KK = KM+KMJ
            JM = JM+1
            T = H(JM)
            H(JM) = H(KK)
            H(KK) = T
            J1 = L
            L = KMJ-1
            IF (L .LE. 0) GO TO 60
               DO 50 M = 1, L
                  JM = JM+J1+M
                  T = H(JM)
                  KM = KM+1
                  H(JM) = H(KM)
                  H(KM) = T
 50               CONTINUE
 60         IF (K1 .GE. P) GO TO 80
               L = P-K1
               K1 = K1-1
               KM = KK
               DO 70 M = 1, L
                  KM = KM+K1+M
                  JM = KM-KMJ
                  T = H(JM)
                  H(JM) = H(KM)
                  H(KM) = T
 70               CONTINUE
 80         K = J
            J = IP(K)
            IP(K) = -J
            IF (J .GT. I) GO TO 10
 90      CONTINUE
 999  RETURN
C  ***  LAST LINE OF  S7IPR FOLLOWS  ***
      END

.