1      SUBROUTINE DSLUPD(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      DOUBLE PRECISION 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      DOUBLE PRECISION DENMIN, SDOTWM, T, UI, WI
21C
22C     ***  CONSTANTS  ***
23      DOUBLE PRECISION HALF, ONE, ZERO
24C
25C  ***  INTRINSIC FUNCTIONS  ***
26C/+
27      DOUBLE PRECISION DABS, DMIN1
28C/
29C  ***  EXTERNAL FUNCTIONS AND SUBROUTINES  ***
30C
31      EXTERNAL  DSLVMU
32      DOUBLE PRECISION DDOT, DNRM2
33C
34C/6
35      DATA HALF/0.5D+0/, ONE/1.D+0/, ZERO/0.D+0/
36C/7
37C     PARAMETER (HALF=0.5D+0, ONE=1.D+0, ZERO=0.D+0)
38C/
39C
40C-----------------------------------------------------------------------
41C
42      SDOTWM = DDOT(P, STEP,1,WCHMTD,1)
43      DENMIN = COSMIN * DNRM2(P,STEP,1) * DNRM2(P,WCHMTD,1)
44      WSCALE = ONE
45      IF (DENMIN .NE. ZERO) WSCALE = DMIN1(ONE, DABS(SDOTWM/DENMIN))
46      T = ZERO
47      IF (SDOTWM .NE. ZERO) T = WSCALE / SDOTWM
48      DO 10 I = 1, P
49 10      W(I) = T * WCHMTD(I)
50      CALL DSLVMU(P, U, A, STEP)
51      T = HALF * (SIZE * DDOT(P, STEP,1,U,1)  -  DDOT(P, STEP,1,Y,1))
52      DO 20 I = 1, P
53 20      U(I) = T*W(I) + Y(I) - SIZE*U(I)
54C
55C  ***  SET  A = A + U*(W**T) + W*(U**T)  ***
56C
57      K = 1
58      DO 40 I = 1, P
59         UI = U(I)
60         WI = W(I)
61         DO 30 J = 1, I
62              A(K) = SIZE*A(K) + UI*W(J) + WI*U(J)
63              K = K + 1
64 30           CONTINUE
65 40      CONTINUE
66C
67 999  RETURN
68C  ***  LAST CARD OF DSLUPD FOLLOWS  ***
69      END
70