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