Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0006/jacobi.mac
There is 1 other file named jacobi.mac in the archive. Click here to see a list.
TITLE JACOBI SUBROUTINE ;JACOBI001
; THIS SUBROUTINE DIAGONALIZES A REAL SYMMETRIC MATRIX OF ORDER N.
; RHO IS THE LARGEST OFF DIAGONAL ELEMENT REMAINING AFTER DIAGONALIZATION.
; F IS THE ARRAY TO BE DIAGONALIZED AND V IS THE EIGENVECTOR MATRIX.
; JACOBI OPERATES ONLY ON THE LOWER LEFT TRIANGLE OF THE MATRIX AND
; ASSUMES THE UPPER HALF.
; MODIFIED TO CONFORM TO CHANGED FORTRAN CONVENTION 9 AUG 80
; BY PAUL T. ROBINSON, WESLEYAN UNIV., DECUS CONVERSION PROGRAMMER
; THIS CONSISTED OF REVISING THE CALL SEQUENCE TO PUSHJ/POPJ CONVENTION
ENTRY JACOBI ;JACOBI002
EXTERN N,RHO,F,V,SQRT ;JACOBI003
; JACOBI:Z ;JACOBI004
JACOBI:MOVEM 16,R16 ;JACOBI005
MOVEM 17,R17 ;JACOBI005
SETZ 4,4 ;TE=0.0 ;JACOBI006
MOVE 13,N(4) ;JACOBI007
MOVE 2,13 ;JACOBI008
FSC 2,233 ;JACOBI009
MOVEM 2,A ;A=FLOAT(N) ;JACOBI010
SUBI 13,1 ;JACOBI011
MOVE 10,RHO(4) ;JACOBI012
MOVEM 10,RHO1 ;JACOBI013
MOVEI 15,1 ;DO 1 I=2,N ;JACOBI014
AA:MOVE 2,15 ;JACOBI015
MOVEI 14,1 ;DO 1 J=1,I-1 ;JACOBI016
B:MOVE 3,F(2) ;JACOBI017
FMPR 3,3 ;JACOBI018
FADR 4,3 ;TE=TE+F(I,J)**2 ;JACOBI019
ADDI 2,74 ;JACOBI020
CAMGE 14,15 ;JACOBI021
AOJA 14,B ;JACOBI022
CAMGE 15,13 ;JACOBI023
AOJA 15,AA ;1 CONTINUE ;JACOBI024
FSC 4,1 ;JACOBI025
; JSA 16,SQRT ;TE=SQRT(2.*TE) ;JACOBI026
; ARG 4,4 ;JACOBI027
EXCH 17,R17 ;GET STACK POINTER BACK
PUSH 17,16 ;SAVE AC
MOVEI 16,[4] ;ARG IS IN 4
PUSHJ 17,SQRT ;CALL
POP 17,16 ;RESTORE AC
EXCH 17,R17 ;RESTORE AC
SETZM 0,MA ;MA=0 ;JACOBI028
C:FDVR 0,A ;2 TE=TE/A ;JACOBI029
CAMGE 0,10 ;JACOBI030
MOVE 0,10 ;JACOBI031
MOVEM 0,TE ;IF (TE.LT.RHO) TE=RHO ;JACOBI032
D:MOVEI 5,74 ;JACOBI033
MOVEI 15,1 ;3 DO 9 II=2,N ;JACOBI034
E:MOVNI 17,1 ;JACOBI035
ADD 17,15 ;JACOBI036
SETZB 6,14 ;DO 9 JJ=1,II-1 ;JACOBI037
FF:MOVE 4,15 ;JACOBI038
ADD 4,6 ;JACOBI039
MOVE 12,F(4) ;JACOBI040
MOVM 3,12 ;JACOBI041
CAMGE 3,TE ;JACOBI042
JRST 0,K ;IF (ABS(F(II,JJ).LT.TE) GO TO 9 ;JACOBI043
MOVEI 2,1 ;JACOBI044
MOVEM 2,MA ;MA=1 ;JACOBI045
MOVEM 12,V2 ;V2=F(II,JJ) ;JACOBI046
MOVEM 4,AD2 ;JACOBI047
MOVE 4,14 ;JACOBI048
ADD 4,6 ;JACOBI049
MOVE 7,F(4) ;JACOBI050
MOVEM 7,V1 ;V1=F(JJ,JJ) ;JACOBI051
MOVEM 4,AD1 ;JACOBI052
MOVE 4,15 ;JACOBI053
ADD 4,5 ;JACOBI054
MOVE 3,F(4) ;JACOBI055
MOVEM 3,V3 ;V3=F(II,II) ;JACOBI056
MOVEM 4,AD3 ;JACOBI057
FSBR 7,3 ;JACOBI058
MOVEM 7,U ;U=V1-V3 ;JACOBI059
MOVE 2,12 ;JACOBI060
FMPR 2,2 ;JACOBI061
FSC 2,2 ;JACOBI062
MOVEM 7,3 ;JACOBI063
FMPR 3,3 ;JACOBI064
FADR 3,2 ;JACOBI065
; JSA 16,SQRT ;JACOBI066
; ARG 3,3 ;JACOBI067
EXCH 17,R17 ;RESTORE STACK POINTER
PUSH 17,16 ;SAVE AC 16
MOVEI 16,[3] ;ARG IS IN 3
PUSHJ 17,SQRT ;CALL
POP 17,16 ;RESTORE 16
EXCH 17,R17 ;RESTORE 17
MOVM 3,7 ;JACOBI068
CAME 3,7 ;JACOBI069
MOVN 0,0 ;Z=SIGN(SQRT(4.*V2**2+U**2),U) ;JACOBI070
MOVE 1,0 ;JACOBI071
MOVE 2,0 ;JACOBI072
FADR 0,7 ;JACOBI073
FDVR 0,1 ;JACOBI074
FSC 0,-1 ;JACOBI075
; JSA 16,SQRT ;JACOBI076
; ARG 0,0 ;JACOBI077
EXCH 17,R17 ;RESTORE STACK POINTER
PUSH 17,16 ;SAVE AC 16
MOVEI 16,[0] ;ARG IS IN 0
PUSHJ 17,SQRT ;CALL
POP 17,16 ;RESTORE 16
EXCH 17,R17 ;RESTORE 17
MOVE 7,0 ;COST=SQRT((Z+U)/(2.*Z)) ;JACOBI078
FMPR 2,7 ;JACOBI079
FDVR 12,2 ;JACOBI080
MOVN 12,12 ;SINT=-V2/(Z*COST) ;JACOBI081
SETZB 2,16 ;DO 8 I=1,N ;JACOBI082
G:CAMGE 16,15 ;JACOBI083
JRST 0,H ;IF (I.LT.II) GO TO 5 ;JACOBI084
MOVE 3,16 ;JACOBI085
ADD 3,6 ;V4=F(I,JJ) ;JACOBI086
MOVE 4,16 ;JACOBI087
ADD 4,5 ;V5=F(I,II) ;JACOBI088
JRST 0,J ;GO TO 7 ;JACOBI089
H:CAML 16,14 ;JACOBI090
JRST 0,I ;5 IF (I.GE.JJ) GO TO 6 ;JACOBI091
MOVE 3,2 ;JACOBI092
ADD 3,14 ;V4=F(JJ,I) ;JACOBI093
MOVE 4,2 ;JACOBI094
ADD 4,15 ;V5=F(II,I) ;JACOBI095
JRST 0,J ;GO TO 7 ;JACOBI096
I:MOVE 3,16 ;JACOBI097
ADD 3,6 ;6 V4=F(I,JJ) ;JACOBI098
MOVE 4,15 ;JACOBI099
ADD 4,2 ;V5=F(II,I) ;JACOBI100
J:MOVE 10,F(3) ;JACOBI101
MOVE 11,F(4) ;JACOBI102
MOVE 0,7 ;JACOBI103
FMPR 0,10 ;JACOBI104
MOVE 1,12 ;JACOBI105
FMPR 1,11 ;JACOBI106
FSBR 0,1 ;F(*,*)=V4*COST-V5*SINT ;JACOBI107
MOVEM 0,F(3) ;PUT THE ANSWERS WHERE V4 AND ;JACOBI108
MOVE 0,12 ;V5 ORIGINALLY CAME FROM ;JACOBI109
FMPR 0,10 ;JACOBI110
MOVE 1,7 ;JACOBI111
FMPR 1,11 ;JACOBI112
FADR 0,1 ;F(*,*)=V4*SINT+V5*COST ;JACOBI113
MOVEM 0,F(4) ;JACOBI114
MOVE 3,16 ;JACOBI115
ADD 3,6 ;V4=V(I,JJ) ;JACOBI116
MOVE 4,16 ;JACOBI117
ADD 4,5 ;V5=V(I,II) ;JACOBI118
MOVE 10,V(3) ;JACOBI119
MOVE 11,V(4) ;JACOBI120
MOVE 0,7 ;JACOBI121
FMPR 0,10 ;JACOBI122
MOVE 1,12 ;JACOBI123
FMPR 1,11 ;JACOBI124
FSBR 0,1 ;V(I,JJ)=V4*COST-V5*SINT ;JACOBI125
MOVEM 0,V(3) ;JACOBI126
MOVE 0,12 ;JACOBI127
FMPR 0,10 ;JACOBI128
MOVE 1,7 ;JACOBI129
FMPR 1,11 ;JACOBI130
FADR 0,1 ;V(I,II)=V4*SINT+V5*COST ;JACOBI131
MOVEM 0,V(4) ;JACOBI132
ADDI 2,74 ;JACOBI133
CAMGE 16,13 ;JACOBI134
AOJA 16,G ;8 CONTINUE ;JACOBI135
MOVE 10,7 ;JACOBI136
FMPR 10,12 ;V4=SINT*COST ;JACOBI137
FMPR 12,12 ;SINT2=SINT**2 ;JACOBI138
FMPR 7,7 ;COST2=COST**2 ;JACOBI139
MOVE 11,V2 ;JACOBI140
MOVE 16,11 ;JACOBI141
FMPR 11,10 ;JACOBI142
FSC 11,1 ;V5=2.*V2*V4 ;JACOBI143
MOVE 0,V1 ;JACOBI144
MOVE 2,0 ;JACOBI145
FMPR 0,12 ;JACOBI146
MOVE 1,V3 ;JACOBI147
MOVE 3,1 ;JACOBI148
FMPR 1,7 ;JACOBI149
FADR 0,1 ;JACOBI150
FADR 0,11 ;JACOBI151
MOVE 4,AD3 ;JACOBI152
MOVEM 0,F(4) ;F(II,II)=V1*SINT2+V3*COST2+V5 ;JACOBI153
FMPR 2,7 ;JACOBI154
FMPR 3,12 ;JACOBI155
FADR 2,3 ;JACOBI156
FSBR 2,11 ;JACOBI157
MOVE 4,AD1 ;JACOBI158
MOVEM 2,F(4) ;F(JJ,JJ)=V1*COST2+V3*SINT2-V5 ;JACOBI159
MOVE 0,U ;JACOBI160
FMPR 0,10 ;JACOBI161
MOVE 1,16 ;JACOBI162
FSBR 7,12 ;JACOBI163
FMPR 1,7 ;JACOBI164
FADR 0,1 ;JACOBI165
MOVE 4,AD2 ;JACOBI166
MOVEM 0,F(4) ;F(II,JJ)=U*V4+V2*(COST2-SINT2);JACOBI167
K:ADDI 6,74 ;JACOBI168
CAMGE 14,17 ;JACOBI169
AOJA 14,FF ;JACOBI170
ADDI 5,74 ;JACOBI171
CAMGE 15,13 ;JACOBI172
AOJA 15,E ;9 CONTINUE ;JACOBI173
MOVE 2,MA ;JACOBI174
SETZM 0,MA ;IF (MA.LT.1) GO TO 10 ;JACOBI175
CAIN 2,1 ;MA=0 ;JACOBI176
JRST 0,D ;GO TO 3 ;JACOBI177
MOVE 0,TE ;JACOBI178
MOVE 10,RHO1 ;JACOBI179
CAMLE 0,10 ;JACOBI180
JRST 0,C ;IF (TE.GT.RHO) GO TO 2 ;JACOBI181
MOVE 16,R16 ;JACOBI182
MOVE 17,R17 ;JACOBI182
; JRA 16,0(16) ;RETURN ;JACOBI183
POPJ 17,
A:Z ;JACOBI184
AD1:Z ;JACOBI185
AD2:Z ;JACOBI186
AD3:Z ;JACOBI187
MA:Z ;JACOBI188
RHO1:Z ;JACOBI189
TE:Z ;JACOBI190
U:Z ;JACOBI191
V1:Z ;JACOBI192
V2:Z ;JACOBI193
V3:Z ;JACOBI194
R16:Z ;JACOBI195
R17:Z ;JACOBI195
END ;JACOBI196
*U*.#
x