dfy=dfy+df*(dy/Rglue):dfx=dfx+df*(dx/Rglue)
into the outer loop with a flag.
Also compared select case with ordinary branching.
(Set up the arrays with some values so the code runs).
Tried to keep out of Case 0 To 10 (only 7 passes through this)
Code: Select all
Const nmass=10000
Redim Shared As Single x(nmass),y(nmass),mc(nmass),vy(nmass),vx(nmass)',kcnt=-7000,dt=.9
Redim Shared As Long x_ERR_m(nmass),x_ERR_n(nmass)
Dim Shared As Single kcnt=-7000,dt=.9
For n As Long=0 To nmass
x(n)=n*n
y(n)=n*n
vx(n)=n
vy(n)=n
Next
Dim Shared As Long NUM_ERROR
Dim Shared As Long n_ERR_part,m_ERR_part
Sub vals1 ()
Dim As Long n,m,flag
Dim As Single dx,dy ,a,df,dfy,dfx,xm,ym
Dim As Single Rglue ,Rgquadro
For n =0 To Nmass
dfx=0
dfy=0
flag=0
For m =0 To Nmass
If n<>m Then
flag=1
dx=x(m)-x(n):dy=y(m)-y(n)
Rgquadro=(dx*dx+dy*dy): Rglue=Sqr (Rgquadro)
Select Case Rglue
Case Is >140
df=9512/((Rgquadro))
Case 10 To 140
df=((-1e12 /Rgquadro)/Rgquadro/Rgquadro)+.4
Case 0 To 10
df=0 : NUM_ERROR=NUM_ERROR+1
x_ERR_m(m) =x(m):x_ERR_m(m) =y(m):
x_ERR_n(n) =x(n):x_ERR_n(n) =y(n):
n_ERR_part =n
m_ERR_part =m
End Select
df=df*mc(m)
'dfy=dfy+df*(dy/Rglue):dfx=dfx+df*(dx/Rglue)
End If
Next m
If flag Then dfy=dfy+df*(dy/Rglue):dfx=dfx+df*(dx/Rglue)
dfy=dfy-y(n)*Kcnt:dfx=dfx-x(n) *Kcnt rem Centering power
vy(n)=vy(n)*.99999:vx(n)=vx(n)*.99999 rem dissipation
vy(n)=vy(n)+dfy*dt:vx(n)=vx(n)+dfx*dt
y(n)=y(n)+vy(n)*dt : x(n)=x(n)+vx(n)*dt
dx=x(m)-x(n):dy=y(m)-y(n)
Next n
End Sub
Sub vals2 ()
Dim As Long n,m,flag
Dim As Single dx,dy ,a,df,dfy,dfx,xm,ym
Dim As Single Rglue ,Rgquadro
For n =0 To Nmass
dfx=0
dfy=0
flag=0
For m =0 To Nmass
If n<>m Then
flag=1
dx=x(m)-x(n):dy=y(m)-y(n)
Rgquadro=(dx*dx+dy*dy): Rglue=Sqr (Rgquadro)
If rglue>140 Then df=9512/((Rgquadro)):Goto skip
If rglue>=10 Then
If rglue<=140 Then
'df=(-1e12 /(Rgquadro*Rgquadro*Rgquadro))+.4:goto skip 'Rock's idea
df=((-1e12 /Rgquadro)/Rgquadro/Rgquadro)+.4 :Goto skip
End If
End If
If rglue >=0 Then
If rglue<=10 Then
df=0 : NUM_ERROR=NUM_ERROR+1
x_ERR_m(m) =x(m):x_ERR_m(m) =y(m):
x_ERR_n(n) =x(n):x_ERR_n(n) =y(n):
n_ERR_part =n
m_ERR_part =m
End If
End If
skip:
df=df*mc(m)
' dfy=dfy+df*(dy/Rglue):dfx=dfx+df*(dx/Rglue)
End If
Next m
If flag Then dfy=dfy+df*(dy/Rglue):dfx=dfx+df*(dx/Rglue)
dfy=dfy-y(n)*Kcnt:dfx=dfx-x(n) *Kcnt rem Centering power
vy(n)=vy(n)*.99999:vx(n)=vx(n)*.99999 rem dissipation
vy(n)=vy(n)+dfy*dt:vx(n)=vx(n)+dfx*dt
y(n)=y(n)+vy(n)*dt : x(n)=x(n)+vx(n)*dt
dx=x(m)-x(n):dy=y(m)-y(n)
Next n
End Sub
print "warming up . . ."
vals1
dim as double t
for k as long=1 to 5
Redim x(nmass),y(nmass),mc(nmass),vy(nmass),vx(nmass)',kcnt=-7000,dt=.9
Redim x_ERR_m(nmass),x_ERR_n(nmass),vy(nmass),vx(nmass)
kcnt=-7000:dt=.9
NUM_ERROR=0
n_ERR_part=0:m_ERR_part =0
For n As Long=0 To nmass
x(n)=n*n
y(n)=n*n
vx(n)=n
vy(n)=n
Next
t=Timer
vals1
Print Timer-t;" method 1",
Print "error ";num_error
Redim x(nmass),y(nmass),mc(nmass),vy(nmass),vx(nmass)',kcnt=-7000,dt=.9
Redim x_ERR_m(nmass),x_ERR_n(nmass),vy(nmass),vx(nmass)
kcnt=-7000:dt=.9
NUM_ERROR=0
n_ERR_part=0:m_ERR_part =0
For n As Long=0 To nmass
x(n)=n*n
y(n)=n*n
vx(n)=n
vy(n)=n
Next
t=Timer
vals2
Print Timer-t;" method 2",
Print "error ";num_error
print
next k
print "done"
Sleep