SUBROUTINE SEQUIV (NR,NRW,M,N,A,B,C,S,RI,W1,W2,RDFLG,RFLAG) C C *****PARAMETERS: INTEGER NR,NRW,M,N CHARACTER RDFLG,RFLAG DOUBLE PRECISION A(NR,N),B(NR,M),C(NR,N),S(NR,M),RI(NR,M), X W1(NRW,N),W2(NRW,N) C C *****LOCAL VARIABLES: INTEGER I,J C C *****FORTRAN FUNCTIONS: C NONE C C *****SUBROUTINES CALLED: C MMUL, MSUB, MULB C C ------------------------------------------------------------------ C C *****PURPOSE: C GIVEN MATRICES A, B, C, S AND RI, THIS SUBROUTINE REPLACES C C A WITH A - B*RI*ST C C C WITH C - S*RI*ST C C WHERE T DENOTES MATRIX TRANSPOSE. C C *****PARAMETER DESCRIPTION: C C ON INPUT: C C NR INTEGER C ROW DIMENSION OF THE ARRAYS CONTAINING THE A, B, C, S C AND RI MATRICES AS DECLARED IN THE MAIN CALLING PROGRAM C DIMENSION STATEMENT; C C NRW INTEGER C ROW DIMENSION OF THE ARRAYS CONTAINING W1 AND W2 AS C DECLARED IN THE MAIN CALLING PROGRAM DIMENSION C STATEMENT; C C M INTEGER C COLUMN DIMENSION OF THE MATRICES B AND S C ORDER OF THE SQUARE MATRIX RI; C C N INTEGER C ROW DIMENSION OF THE MATRICES B AND S C ORDER OF THE SQUARE MATRICES A AND C; C C A REAL(NR,N) C N BY N INPUT MATRIX THAT IS MODIFIED BY THIS ROUTINE; C C B REAL(NR,M) C N BY M INPUT MATRIX; C C C REAL(NR,N) C N BY N INPUT MATRIX THAT IS MODIFIED BY THIS ROUTINE; C C S REAL(NR,M) C N BY M INPUT MATRIX; C C RI REAL(NR,M) C M BY M INPUT MATRIX; C C W1 REAL(NRW,N) C SCRATCH ARRAY OF SIZE AT LEAST M BY N; C C W2 REAL(NRW,N) C SCRATCH ARRAY OF SIZE AT LEAST N BY N; C C RDFLG CHARACTER C FLAG SET TO 'Y' IF RI IS A DIAGONAL MATRIX; C C RFLAG CHARACTER C FLAG SET TO 'Y' IF RI IS OTHER THAN THE IDENTITY MATRIX. C C ON OUTPUT: C C A MODIFIED AS INDICATED ABOVE; C C C MODIFIED AS INDICATED ABOVE. C C *****ALGORITHM NOTES: C NONE. C C *****HISTORY: C THIS SUBROUTINE WAS WRITTEN BY W.F. ARNOLD, NAVAL WEAPONS CENTER, C CODE 35104, CHINA LAKE, CA 93555, AS PART OF THE SOFTWARE PACKAGE C RICPACK, SEPTEMBER 1983. C MODIFIED BY ALAN J. LAUB (UCSB): 01/06/85 C C ------------------------------------------------------------------ C IF(RDFLG .EQ. 'Y' .OR. RDFLG .EQ. 'y') GO TO 10 CALL TRNATB(NR,NRW,N,M,S,W1) IF(RFLAG .NE. 'Y' .OR. RFLAG .NE. 'y') GO TO 40 CALL MULB(NR,NRW,M,M,N,RI,W1,W2) GO TO 40 10 CONTINUE DO 30 J=1,N DO 20 I=1,M W1(I,J) = RI(I,I)*S(J,I) 20 CONTINUE 30 CONTINUE 40 CONTINUE CALL MMUL(NR,NRW,NRW,N,N,M,S,W1,W2) CALL MSUB(NR,NRW,NR,N,N,C,W2,C) CALL MMUL(NR,NRW,NRW,N,N,M,B,W1,W2) CALL MSUB(NR,NRW,NR,N,N,A,W2,A) RETURN C C LAST LINE OF SEQUIV C END