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