PrivateSubCommand1_Click()DimdAsDouble,tAsDouble,f1AsDouble,f2AsDouble,f3AsDouble,ggAsDouble,p1AsDouble,p2AsDouble,x1AsDouble,x2AsDoubleDimrs(0To2)AsDouble,rsp(0To2)AsDoubleConstpi=3.1415927d=Val(Text1.Text)t=Val(Text2.Text)f1=Val(Text3.Text)f2=Val(Text4.Text)f3=Val(Text5.Text)ForI=0To2rs(I)=0NextIgg=t/dp1=0.02Callf1f2f3(gg,p1,rs())Printgg,p1,rs(0),rs(1),rs(2)x1=rs(0)/rs(1)-f1/f2DoWhileTruep2=p10.001Callf1f2f3(gg,p2,rs())x2=rs(0)/rs(1)-f1/f2Ifx1*x20Thenp1=p2x1=x2Ifp20.5ThenText8.Text=\"周波数データ异常\"EndEndIfElsersp(0)=(p1p2)/2ExitDoEndIfLoopText6.Text=rsp(0)Iff3-f2=0ThenText8.Text=\"周波数f3异常\"EndEndIfp1=rsp(0)-0.05Ifp10.02Thenp1=0.02Callf1f2f3(gg,p1,rs())x1=rs(0)/rs(2)-f1/f3DoWhileTruep2=p10.001Callf1f2f3(gg,p2,rs())x2=rs(0)/rs(2)-f1/f3Ifx1*x20Thenp1=p2x1=x2Ifp20.5ThenText8.Text=\"周波数f3异常\"EndEndIfElse:rsp(1)=(p1p2)/2ExitDoEndIfLoopText7.Text=rsp(1)rsp2=(rsp(0)rsp(1))/2Text8.Text=rsp(2)EndSubPrivateSubf1f2f3(ggAsDouble,pAsDouble,f()AsDouble)DimflAsDouble,yAsDouble,x(0To2)AsDouble,fg(0To2)AsDouble,a(0To2)AsDouble,b(0To2)AsDouble,c(0To2)AsDouble,g(0To2)AsDoublefl=pi/2*Sqr(1-p^2)y=1Callr3j0j1(y,x())ForI=0To2fg(I)=x(I)*Sqr(1-p)g(I)=pi/2/x(I)NextIy=1-pCallr3j0j1(y,x())ForI=0To2c(I)=p*(x(I)^2/fg(I)^2-1)a(I)=x(I)^2b(I)=(fl/gg)^2f(I)=Sqr((a(I)b(I))^2-4*(1-c(I))*a(I)*b(I))f(I)=(a(I)b(I)-f(I))/2/(1-c(I))f(I)=Sqr(f(I))NextIEndSubPrivateSubr3j0j1(yAsDouble,x()AsDouble)Dimxx1AsDouble,x0AsDoublex0=0xx1=0.1Callxj0j1y(y,xx1,x0)x(0)=x0Callxj0j1y(y,xx1,x0)x(1)=x0Callxj0j1y(y,xx1,x0)x(2)=x0EndSubPrivateSubxj0j1y(yAsDouble,xx1AsDouble,xAsDouble)DimdxAsDouble,xxAsDouble,bj0AsDouble,bj1AsDouble,y1AsDouble,y2AsDoubledx=0.1bj0=0bj1=0Callj0j1(xx1,bj0,bj1)y1=xx1*bj0-bj1*yDoWhileTruexx=xx1dxCallj0j1(xx,bj0,bj1)y2=xx*bj0-bj1*yIfy1*y20Theny1=y2xx1=xxElseIfdx0.0001ThenExitDoElse:dx=dx/10EndIfLoopx=(xxxx1)/2xx1=xxEndSubPrivateSubj0j1(xAsDouble,z0AsDouble,z1AsDouble)Dimz2AsDoublez2=1z0=z2Fork=1To500z2=z2*(-1)/k^2*x^2/4z0=z0z2Nextkz2=x/2z1=z2Fork=1To500z2=z2*(-1)/k/(k1)*x^2/4z1=z1z2NextkEndSub
|
