Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
      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.
      ENTRY  JACOBI						      ;JACOBI002
      EXTERN  N,RHO,F,V,SQRT					      ;JACOBI003
      JACOBI:Z							      ;JACOBI004
      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
      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
      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
      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
      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