VB常用算法源代码

整理文档很辛苦,赏杯茶钱您下走!

免费阅读已结束,点击下载阅读编辑剩下 ...

阅读已结束,您可以下载文档离线阅读编辑

资源描述

1.高斯函数GAUSSJSubGAUSSJ(A(),N,B())DimIPIV(50),INDXR(50),INDXC(50)ForJ=1ToNIPIV(J)=0NextJForI=1ToNBIG=0#ForJ=1ToNIfIPIV(J)1ThenForK=1ToNIfIPIV(K)=0ThenIfAbs(A(J,K))=BIGThenBIG=Abs(A(J,K))IROW=JICOL=KEndIfElseIfIPIV(K)1ThenPrintSingularmatrixEndIfNextKEndIfNextJIPIV(ICOL)=IPIV(ICOL)+1IfIROWICOLThenForL=1ToNDUM=A(IROW,L)A(IROW,L)=A(ICOL,L)A(ICOL,L)=DUMNextLDUM=B(IROW)B(IROW)=B(ICOL)B(ICOL)=DUMEndIfINDXR(I)=IROWINDXC(I)=ICOLIfA(ICOL,ICOL)=0#ThenPrintSingularmatrix.PIVINV=1#/A(ICOL,ICOL)A(ICOL,ICOL)=1#ForL=1ToNA(ICOL,L)=A(ICOL,L)*PIVINVNextLB(ICOL)=B(ICOL)*PIVINVForLL=1ToNIfLLICOLThenDUM=A(LL,ICOL)A(LL,ICOL)=0#ForL=1ToNA(LL,L)=A(LL,L)-A(ICOL,L)*DUMNextLB(LL)=B(LL)-B(ICOL)*DUMEndIfNextLLNextIForL=NTo1Step-1IfINDXR(L)INDXC(L)ThenForK=1ToNDUM=A(K,INDXR(L))A(K,INDXR(L))=A(K,INDXC(L))A(K,INDXC(L))=DUMNextKEndIfNextLEndSub2.松弛迭代SubSSOR(A(),N,B(),X(),EPS,OM,II)IMAX=200ForI=1ToNR=1#/A(I,I)B(I)=B(I)*RForJ=1ToNA(I,J)=A(I,J)*RNextJNextIForII=1ToIMAXRX=0#ForI=1ToNR=B(I)ForJ=1ToNR=R-A(I,J)*X(J)NextJIfAbs(R)RXThenRX=Abs(R)X(I)=X(I)+OM*RNextIIfOM*RX=EPSThenExitSubNextIIPrintToomanyiterationsEndSub3.SVDCMPSubSVDCMP(A(),M,N,W(),V())DimRV1(100)IfMNThenPrintYoumustaugmentAwithextrazerorows.G=0#SCALE1=0#ANORM=0#ForI=1ToNL=I+1RV1(I)=SCALE1*GG=0#S=0#SCALE1=0#IfI=MThenForK=IToMSCALE1=SCALE1+Abs(A(K,I))NextKIfSCALE10#ThenForK=IToMA(K,I)=A(K,I)/SCALE1S=S+A(K,I)*A(K,I)NextKF=A(I,I)G=-Sqr(S)*Sgn(F)H=F*G-SA(I,I)=F-GIfINThenForJ=LToNS=0#ForK=IToMS=S+A(K,I)*A(K,J)NextKF=S/HForK=IToMA(K,J)=A(K,J)+F*A(K,I)NextKNextJEndIfForK=IToMA(K,I)=SCALE1*A(K,I)NextKEndIfEndIfW(I)=SCALE1*GG=0#S=0#SCALE1=0#IfI=MAndINThenForK=LToNSCALE1=SCALE1+Abs(A(I,K))NextKIfSCALE10#ThenForK=LToNA(I,K)=A(I,K)/SCALE1S=S+A(I,K)*A(I,K)NextKF=A(I,L)G=-Sqr(S)*Sgn(F)H=F*G-SA(I,L)=F-GForK=LToNRV1(K)=A(I,K)/HNextKIfIMThenForJ=LToMS=0#ForK=LToNS=S+A(J,K)*A(I,K)NextKForK=LToNA(J,K)=A(J,K)+S*RV1(K)NextKNextJEndIfForK=LToNA(I,K)=SCALE1*A(I,K)NextKEndIfEndIfIfANORMAbs(W(I))+Abs(RV1(I))ThenANORM=ANORMElseANORM=Abs(W(I))+Abs(RV1(I))EndIfNextIForI=NTo1Step-1IfINThenIfG0#ThenForJ=LToNV(J,I)=(A(I,J)/A(I,L))/GNextJForJ=LToNS=0#ForK=LToNS=S+A(I,K)*V(K,J)NextKForK=LToNV(K,J)=V(K,J)+S*V(K,I)NextKNextJEndIfForJ=LToNV(I,J)=0#V(J,I)=0#NextJEndIfV(I,I)=1#G=RV1(I)L=INextIForI=NTo1Step-1L=I+1G=W(I)IfINThenForJ=LToNA(I,J)=0#NextJEndIfIfG0#ThenG=1#/GIfINThenForJ=LToNS=0#ForK=LToMS=S+A(K,I)*A(K,J)NextKF=(S/A(I,I))*GForK=IToMA(K,J)=A(K,J)+F*A(K,I)NextKNextJEndIfForJ=IToMA(J,I)=A(J,I)*GNextJElseForJ=IToMA(J,I)=0#NextJEndIfA(I,I)=A(I,I)+1#NextIForK=NTo1Step-1ForITS=1To30ForL=KTo1Step-1NM=L-1IfAbs(RV1(L))+ANORM=ANORMThenGoTo2IfAbs(W(NM))+ANORM=ANORMThenGoTo1NextL1C=0#S=1#ForI=LToKF=S*RV1(I)IfAbs(F)+ANORMANORMThenG=W(I)H=Sqr(F*F+G*G)W(I)=HH=1#/HC=(G*H)S=-(F*H)ForJ=1ToMY=A(J,NM)Z=A(J,I)A(J,NM)=(Y*C)+(Z*S)A(J,I)=-(Y*S)+(Z*C)NextJEndIfNextI2Z=W(K)IfL=KThenIfZ0#ThenW(K)=-ZForJ=1ToNV(J,K)=-V(J,K)NextJEndIfGoTo3EndIfIfITS=30ThenPrintNoconvergencein30iterationsX=W(L)NM=K-1Y=W(NM)G=RV1(NM)H=RV1(K)F=((Y-Z)*(Y+Z)+(G-H)*(G+H))/(2#*H*Y)G=Sqr(F*F+1#)F=((X-Z)*(X+Z)+H*((Y/(F+Abs(G)*Sgn(F)))-H))/XC=1#S=1#ForJ=LToNMI=J+1G=RV1(I)Y=W(I)H=S*GG=G*CZ=Sqr(F*F+H*H)RV1(J)=ZC=F/ZS=H/ZF=(X*C)+(G*S)G=-(X*S)+(G*C)H=Y*SY=Y*CForNM=1ToNX=V(NM,J)Z=V(NM,I)V(NM,J)=(X*C)+(Z*S)V(NM,I)=-(X*S)+(Z*C)NextNMZ=Sqr(F*F+H*H)W(J)=ZIfZ0#ThenZ=1#/ZC=F*ZS=H*ZEndIfF=(C*G)+(S*Y)X=-(S*G)+(C*Y)ForNM=1ToMY=A(NM,J)Z=A(NM,I)A(NM,J)=(Y*C)+(Z*S)A(NM,I)=-(Y*S)+(Z*C)NextNMNextJRV1(L)=0#RV1(K)=FW(K)=XNextITS3AAAAA=1NextKEndSub

1 / 8
下载文档,编辑使用

©2015-2020 m.777doc.com 三七文档.

备案号:鲁ICP备2024069028号-1 客服联系 QQ:2149211541

×
保存成功