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