1      SUBROUTINE SLUPDT(A, COSMIN, P, SIZE, STEP, U, W, WCHMTD, WSCALE,
2     1                  Y)
3C
4C  ***  UPDATE SYMMETRIC  A  SO THAT  A * STEP = Y  ***
5C  ***  (LOWER TRIANGLE OF  A  STORED ROWWISE       ***
6C
7C***REVISION HISTORY  (YYMMDD)
8C   000330  Modified array declarations.  (JEC)
9C
10C  ***  PARAMETER DECLARATIONS  ***
11C
12      INTEGER P
13      REAL A(*), COSMIN, SIZE, STEP(P), U(P), W(P),
14     1                 WCHMTD(P), WSCALE, Y(P)
15C     DIMENSION A(P*(P+1)/2)
16C
17C  ***  LOCAL VARIABLES  ***
18C
19      INTEGER I, J, K
20      REAL DENMIN, SDOTWM, T, UI, WI
21C
22C     ***  CONSTANTS  ***
23      REAL HALF, ONE, ZERO
24C
25C  ***  INTRINSIC FUNCTIONS  ***
26C/+
27      REAL  ABS, AMIN1
28C/
29C  ***  EXTERNAL FUNCTIONS AND SUBROUTINES  ***
30C
31      EXTERNAL  SLVMUL
32C
33C/6
34C     DATA HALF/0.5E+0/, ONE/1.E+0/, ZERO/0.E+0/
35C/7
36      PARAMETER (HALF=0.5E+0, ONE=1.E+0, ZERO=0.E+0)
37C/
38C
39C-----------------------------------------------------------------------
40C
41      SDOTWM = SDOT(P,STEP,1,WCHMTD,1)
42      DENMIN = COSMIN * SNRM2(P,STEP,1) * SNRM2(P,WCHMTD,1)
43      WSCALE = ONE
44      IF (DENMIN .NE. ZERO) WSCALE = AMIN1(ONE,  ABS(SDOTWM/DENMIN))
45      T = ZERO
46      IF (SDOTWM .NE. ZERO) T = WSCALE / SDOTWM
47      DO 10 I = 1, P
48 10      W(I) = T * WCHMTD(I)
49      CALL SLVMUL(P, U, A, STEP)
50      T = HALF * (SIZE * SDOT(P,STEP,1,U,1)  -  SDOT(P,STEP,1,Y,1))
51      DO 20 I = 1, P
52 20      U(I) = T*W(I) + Y(I) - SIZE*U(I)
53C
54C  ***  SET  A = A + U*(W**T) + W*(U**T)  ***
55C
56      K = 1
57      DO 40 I = 1, P
58         UI = U(I)
59         WI = W(I)
60         DO 30 J = 1, I
61              A(K) = SIZE*A(K) + UI*W(J) + WI*U(J)
62              K = K + 1
63 30           CONTINUE
64 40      CONTINUE
65C
66 999  RETURN
67C  ***  LAST CARD OF SLUPDT FOLLOWS  ***
68      END
69