MSOLV TITLE 'MSOLV - SOLVE TRI-DIAGONAL MATRIX' 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *TITLEMSOLV -- SOLVE TRI-DIAGONAL MATRIX 00020000 *********************************************************************** 00030000 *A AUTHOR HENRY LAVALLET 00040000 *A DESIGNER RALPH MCMILLAN 00050000 *A LANGUAGE S/370 ASSEMBLER F 00060000 *A SYSTEM IBM (SEE CRAY) 00070000 *A WRITTEN 03-26-80 00080000 ** REVISED 11-15-84 HHL ADDED SAVEAREA AND CHAINING 00090000 ** REVISED 04-16-86 REM/ESN SUBTRACT 1 IN ADDR. CALC. OF00100002 ** T(N) AND ELIMINATE USE OF 'CNTL'. 00110000 ** REVISED 00120000 *A 00130000 ** CALLING SEQUENCE: (FROM FORTRAN PROGRAM - SAMIGR) 00140000 *A CALL MSOLV (A, E, DEN, N, T, D) 00150000 *A INPUT A = OFF DIAG.ELEMENTS FROM TRI-DIAG. MATRIX R4 00160000 *A INPUT E = AUX ARRAY CALCULATED IN MINVT R4 00170000 *A INPUT DEN = AUX ARRAY CALCULATED IN MINVT R4 00180000 *A INPUT N = NUMBER OF ELEMENTS IN A,E,DEN,T,AND D I4 00190000 *A OUTPUT T = SOLUTION OF TRI-DIAGONAL SYSTEM R4 00200000 *A IN/OUT D = RT. HAND SIDE OF TRI-DIAGONAL SYSTEM R4 00210000 *A 00220000 *A THIS SUBROUTINE SOLVES A TRI-DIAGONAL MATRIX AND IS A 00230000 *A REWRITE OF THE FORTRAN SUBROUTINE MASOLV. 00240000 *A 00250000 *********************************************************************** 00260000 EJECT 00270000 *********************************************************************** 00280000 * * 00290000 * REGISTER EQUATES * 00300000 * * 00310000 *********************************************************************** 00320000 SPACE 2 00330000 R0 EQU 0 00340000 R1 EQU 1 00350000 R2 EQU 2 00360000 R3 EQU 3 00370000 R4 EQU 4 00380000 R5 EQU 5 00390000 R6 EQU 6 00400000 R7 EQU 7 00410000 R8 EQU 8 00420000 R9 EQU 9 00430000 R10 EQU 10 00440000 R11 EQU 11 00450000 R12 EQU 12 00460000 R13 EQU 13 00470000 R14 EQU 14 00480000 R15 EQU 15 00490000 ** 00500000 FPR0 EQU 0 FLT PT REG 0 00510000 FPR2 EQU 2 FLT PT REG 2 00520000 FPR4 EQU 4 FLT PT REG 4 00530000 FPR6 EQU 6 FLT PT REG 6 00540000 ** 00550000 EJECT 00560000 *********************************************************************** 00570000 * * 00580000 * PROGRAM MAINLINE * 00590000 * * 00600000 *********************************************************************** 00610000 SPACE 2 00620000 MSOLV CSECT 00630000 USING *,R15 00640000 B START BRANCH AROUND ID 00650000 DC XL1'07' 00660000 DC CL7'MSOLV ' 00670000 START DS 0H 00680000 STM R14,R12,12(R13) SAVE CALLERS REGS 00690000 LA R2,SAVE 00700000 ST R2,8(R13) CHAIN SAVE AREA 00710000 ST R13,SAVE+4 POINTER TO OLD SAVE AREA 00720000 ST R13,MYSAVE POINTER TO OLD SAVE AREA 00730000 LR R13,R2 POINTER TO NEW SAVE AREA 00740000 SPACE 1 00750000 *********************************************************************** 00760000 * * 00770000 * BEGIN PROCESSING * 00780000 * * 00790000 *********************************************************************** 00800000 SPACE 1 00810000 LM R3,R8,0(R1) LOAD INPUT PARMS AS FOLLOWS: 00820000 *** R3 = ADDR(A) 00830000 *** R4 = ADDR(E) 00840000 *** R5 = ADDR(DEN) 00850000 *** R6 = ADDR(N) 00860000 *** R7 = ADDR(T) 00870000 *** R8 = ADDR(D) 00880000 L R6,0(R6) LOAD VALUE OF N 00890000 ST R6,NSAV SAVE FOR LATER USE 00900000 SR R10,R10 SET DISPLACEMENT REG = 0 00910000 LE FPR0,FPK0 LOAD FLT PT 0. 00920000 STE FPR0,0(R8) SET D(1) = 0. 00930000 S R6,K2 SET UP LOOP CNTL REG 00940000 SPACE 1 00950000 *********************************************************************** 00960000 * * 00970000 * BEGIN FIRST LOOP FOR CALCULATIONS * 00980000 * * 00990000 *********************************************************************** 01000000 SPACE 1 01010000 LOOP DS 0H I = 2,NM1 (NM1 = N-1) 01020000 LE FPR4,4(R10,R8) D(I) 01030000 LE FPR2,4(R10,R3) A(I) 01040000 ME FPR2,0(R10,R8) A(I) * D(I-1) THEN SUBTRACT 01050000 SER FPR4,FPR2 FROM D(I) AND DIVIDE 01060000 DE FPR4,4(R10,R5) BY DEN(I) THEN SAVE AS 01070000 STE FPR4,4(R10,R8) NEW VALUE OF D(I) 01080000 LA R10,4(R10) BUMP DSPL REG FOR NEXT TBL LOC 01090000 BCT R6,LOOP AND DO CALCULATIONS AGAIN 01100000 *** 01110000 L R1,NSAV RELOAD VALUE OF N 01120000 BCTR R1,0 DECREMENT FOR NM1 NM1 = N-1 01130000 LR R10,R1 SAVE FOR NEXT LOOP CALCULATION 01140001 BCTR R1,0 ESN -- DECREMENT AGAIN FOR ADDR. 01150000 SLL R1,2 MULT BY 4 TO ACCESS TBL LOCS 01160000 LE FPR4,0(R1,R8) LOAD D(NM1) 01170000 LE FPR2,FPK1 PICK UP FLT PT VALUE 1.0 01180000 SE FPR2,0(R1,R4) 1.0 - E(NM1) THEN DIVIDE 01190000 DER FPR4,FPR2 INTO D(NM1) AND SAVE 01200000 STE FPR4,4(R1,R7) IN T(N), WHERE N = NM+1 01210000 SPACE 1 01220000 *********************************************************************** 01230000 * * 01240000 * BEGIN SECOND LOOP CALCULATIONS * 01250000 * * 01260000 *********************************************************************** 01270000 SPACE 1 01280000 LOOP2 DS 0H 01290000 LR R1,R10 SET UP DSPL REG INTO TBL LOCS 01300000 BCTR R1,0 01310000 SLL R1,2 MULT BY 4 FOR TBL ENTRIES (4 BYTE) 01320000 LE FPR2,0(R1,R4) LOAD E(I), I=N-J, J=1,NM1 01330000 ME FPR2,4(R1,R7) E(I) * T(I+1) THEN 01340000 AE FPR2,0(R1,R8) ADD D(I) AND SAVE 01350000 STE FPR2,0(R1,R7) IN T(I) LOCATION 01360000 BCT R10,LOOP2 DO IT AGAIN 01370000 *** 01380000 L R13,MYSAVE PREPARE TO RESTORE REGS AND 01390000 L R14,12(R13) RETURN TO CALLER 01400000 MVI 12(R13),X'FF' 01410000 LM R2,R12,28(R13) 01420000 BR R14 RETURN 01430000 SPACE 2 01440000 *********************************************************************** 01450000 * * 01460000 * CONSTANTS AND SAVE AREAS * 01470000 * * 01480000 *********************************************************************** 01490000 SPACE 1 01500000 MYSAVE DC F'0' REGISTER SAVE AREA 01510000 SAVE DC 18F'0' REGISTER SAVE AREA 01520000 NSAV DC F'0' SAVE LOC FOR VALUE N 01530000 FPK1 DC E'1.0' FLT PT CONSTANT 1.0 01540000 FPK0 DC E'0.0' FLT PT CONSTANT 0.0 01550000 K2 DC F'2' CONSTANT 2 01560000 LTORG 01570000 END MSOLV 01580000