I have very tedious task to optimize some ancient Fortran77 code. Honestly, I don't know fortran at all. I know how loops works and how to multiply matrices. I also know that this loop can be optimized to few 3-4 nested loops:
do i = 1, nocca
do j = 1, nocca
do k = 1, noccb
do l = 1, noccc
do m = 1, nva
do n =1, nvb
saps = oab(j, n+noccb)
sbap = oab(j, k)
sac = oac(i, l)
scr = oac(m + nocca, l)
im = i + nocca*(m-1)
kn = k + noccb*(n-1)
imkn = im + oava*(kn-1)
vrsab = ovovab(imkn)
demp3 = demp3 + 2.0d0*vrsab*(2.0d0*saps*sbap*sac*scr)
end do
end do
end do
end do
end do
end do
I was trying to calculate sapssac in the separate loop and similarly sacscr:
c Calculate saps * sbap
do j = 1, nocca
do k = 1, noccb
do n = 1, nvb
saps = oab(j, n + noccb)
sbap = oab(j, k)
saps_sbap(j, k) = saps_sbap(j, k) + saps*sbap
end do
end do
end do
c Calculate sac_scr
do i = 1, nocca
do l = 1, noccc
do m = 1, nva
sac = oac(i, l)
scr = oac(m + nocca, l)
sac_scr(i, l) = sac_scr(i, l) + sac*scr
end do
end do
end do
Finally I would like to write the last part to calculate demp3 but there are 5 indices not 4 as I expected. Maybe I'm doing this entirely wrong?
Any suggestions? hints?
Thanks in advance!
It is clearly easier to downwote than try to understand a problem. I found optimal solution by myself. Here it is:
Split large sum into two components. Let's consider only the first one:
demp3 = demp3 + 2.0d0*vrsab*(2.0d0*saps*sbap*sac*scr)
Multiply sapssbap and sacscr in two separate loops. (Dimensions can be found as maximal indices in the original loop):
REAL*16, DIMENSION(nvb, noccb) :: saps_sbap
REAL*16, DIMENSION(nocca, nva) :: sac_scr
following loops multiply sapssbap and sacscr:
c Calculate saps * sbap
do k = 1, noccb
do n = 1, nvb
saps_sbap(n, k) = 0.0d0
do j = 1, nocca
saps = oab(j, n + noccb)
sbap = oab(j, k)
saps_sbap(n, k) = saps_sbap(n, k) + saps*sbap
end do
end do
end do
c Calculate sac * scr
do i = 1, nocca
do m = 1, nva
sac_scr(i, m) = 0.0d0
do l = 1, noccc
sac = oac(i, l)
scr = oac(m + nocca, l)
sac_scr(i, m) = sac_scr(i, m) + sac*scr
end do
end do
end do
Finally put all things together in such a loop:
do i = 1, nocca
do k = 1, noccb
do m = 1, nva
do n = 1, nvb
im = i + nocca*(m-1)
kn = k + noccb*(n-1)
imkn = im +oava*(kn-1)
vrsab = ovovab(imkn)
demp3 = demp3 + 2.0d0 * vrsab * 2.0d0 *saps_sbap(n,k) * sac_scr(i,m)
end do
end do
end do
end do
In such a way instead of O(N^6) loop there are two O(N^3) and one O(N^4)
Sorry for the last piece format, line-end didn't worked.
I have function, which convert result from FFT to octave band (or 1/n - octave):
Function OctaveFilter(LowFreq, HighFreq, Im, Re) 'For amplitude
Dim i, j, SortedData(), F_From(), F_To()
Redim SortedData(Bins * n), F_From(Bins * n), F_To(Bins * n)
Dim p
For i = 1 To Bins * n
F_To(i) = Int(HighFreq(i) / df)
F_From(i) = Int(LowFreq(i) / df)
if (F_From(i) = 0) Then F_From(i) = 1 ' We cannot start from index 0
Next
For i = 1 To Bins * n
SortedData(i) = 0
For j = F_From(i) To F_To(i)
If (Length >= j) Then
SortedData(i) = SortedData(i) + Im(j)^2 + Re(j)^2
End If
Next
Next
SortInBins = sqrt(SortedData)
End Function
For example this FFT:
Amplitude
converts to this 1/3- octave bands:
1/3 - octave
But from FFT I also have Re and Im part. I want to convert these parts to octave band too. Is it the same function? How can I convert this Im part imaginary part to similar result (1/3 - octave) ?
I'm trying to do a Gaussian bell using the data I am obtaining from a matrix but everytime I try to run the program I obtain this message:
"Error: syntax error, unexpected identifier, expecting end"
The data used to obtain the gaussina bell is a matrix which includes the last point of every n displacements, which are the last position of a particle. I want to know if there is an easier way to obtain the gaussian bell in scilab because I have to also do a fit with an histogram using the same data.
function bla7()
t=4000
n=1000
l=0.067
p=%pi*2
w1=zeros(t,1);
w2=zeros(t,1);
for I=1:t
a=(grand(n,1,"unf",0,p));
x=l*cos(a)
y=l*sin(a)
z1=zeros(n,1);
z2=zeros(n,1);
for i=2:n
z1(i)=z1(i-1)+x(i);
z2(i)=z2(i-1)+y(i);
end
w1(I)=z1($)
w2(I)=z2($)
end
n=10000
w10=zeros(t,1);
w20=zeros(t,1);
for I=1:t
a=(grand(n,1,"unf",0,p));
x=l*cos(a)
y=l*sin(a)
z1=zeros(n,1);
z2=zeros(n,1);
for i=2:n
z1(i)=z1(i-1)+x(i);
z2(i)=z2(i-1)+y(i);
end
w10(I)=z1($)
w20(I)=z2($)
end
n=100
w100=zeros(t,1);
w200=zeros(t,1);
for I=1:t
a=(grand(n,1,"unf",0,p));
x=l*cos(a)
y=l*sin(a)
z1=zeros(n,1);
z2=zeros(n,1);
for i=2:n
z1(i)=z1(i-1)+x(i);
z2(i)=z2(i-1)+y(i);
end
w100(I)=z1($)
w200(I)=z2($)
end
k=70
v=12/k
c1=zeros(k,1)
for r=1:t
c=w1(r)
m=-6+v
n=-6
for g=1:k
if (c<m & c>=n) then
c1(g)=c1(g)+1
m=m+v
n=n+v
else
m=m+v
n=n+v
end
end
end
c2=zeros(k,1)
c2(1)=-6+(6/k)
for b=2:k
c2(b)=c2(b-1)+v
end
y = stdev(w1)
normal1=zeros(k,1)
normal2=zeros(k,1)
bb=-6
bc=-6+v
for wa=1:k
bd=(bb+bc)/2
gauss1=(1/(y*sqrt(2*%pi)))exp(-0.5(bb/y)^2)
gauss2=(1/(y*sqrt(2*%pi)))exp(-0.5(bc/y)^2)
gauss3=(1/(y*sqrt(2*%pi)))exp(-0.5(bd/y)^2)
gauss4=((bc-bb)/6)*(gauss1+gauss2+4*gauss3)
bb=bb+v
bc=bc+v
normal2(wa,1)=gauss4
end
normal3=normal2*4000
k=100
v=24/k
c10=zeros(k,1)
for r=1:t
c=w10(r)
m=-12+v
n=-12
for g=1:k
if (c<m & c>=n) then
c10(g)=c10(g)+1
m=m+v
n=n+v
else
m=m+v
n=n+v
end
end
end
c20=zeros(k,1)
c20(1)=-12+(12/k)
for b=2:k
c20(b)=c20(b-1)+v
end
y = stdev(w10)
normal10=zeros(k,1)
normal20=zeros(k,1)
bb=-12
bc=-12+v
for wa=1:k
bd=(bb+bc)/2
gauss10=(1/(y*sqrt(2*%pi)))exp(-0.5(bb/y)^2)
gauss20=(1/(y*sqrt(2*%pi)))exp(-0.5(bc/y)^2)
gauss30=(1/(y*sqrt(2*%pi)))exp(-0.5(bd/y)^2)
gauss40=((bc-bb)/6)*(gauss10+gauss20+4*gauss30)
bb=bb+v
bc=bc+v
normal20(wa,1)=gauss40
end
normal30=normal20*4000
k=70
v=12/k
c100=zeros(k,1)
for r=1:t
c=w100(r)
m=-6+v
n=-6
for g=1:k
if (c<m & c>=n) then
c100(g)=c100(g)+1
m=m+v
n=n+v
else
m=m+v
n=n+v
end
end
end
c200=zeros(k,1)
c200(1)=-6+(6/k)
for b=2:k
c200(b)=c200(b-1)+v
end
y = stdev(w100)
normal100=zeros(k,1)
normal200=zeros(k,1)
bb=-6
bc=-6+v
for wa=1:k
bd=(bb+bc)/2
gauss100=(1/(y*sqrt(2*%pi)))exp(-0.5(bb/y)^2)
gauss200=(1/(y*sqrt(2*%pi)))exp(-0.5(bc/y)^2)
gauss300=(1/(y*sqrt(2*%pi)))exp(-0.5(bd/y)^2)
gauss400=((bc-bb)/6)*(gauss100+gauss200+4*gauss300)
bb=bb+v
bc=bc+v
normal200(wa,1)=gauss400
end
normal300=normal200*4000
bar(c20,c10,1.0,'white')
plot(c20, normal30, 'b-')
bar(c2,c1,1.0,'white')
plot(c2, normal3, 'r-')
bar(c200,c100,1.0,'white')
plot(c200, normal300, 'm-')
poly1.thickness=3;
xlabel(["x / um"]);
ylabel("molecules");
gcf().axes_size=[500,500]
a=gca();
a.zoom_box=[-12,12;0,600];
a.font_size=4;
a.labels_font_size=5;
a.x_label.font_size = 5;
a.y_label.font_size = 5;
ticks = a.x_ticks
ticks.labels =["-12";"-10";"-8";"-6";"-4";"-2";"0";"2";"4";"6";"8";"10";"12"]
ticks.locations = [-12;-10;-8;-6;-4;-2;0;2;4;6;8;10;12]
a.x_ticks = ticks
endfunction
Each and every one of your gauss variables are missing the multiplication operator in two places. Check every line at it will run. For example, this:
gauss1=(1/(y*sqrt(2*%pi)))exp(-0.5(bb/y)^2)
should be this:
gauss1=(1/(y*sqrt(2*%pi))) * exp(-0.5 * (bb/y)^2)
As for the Gaussian bell, there is no standard function in Scilab. However, you could define a new function to make things more clear in your case:
function x = myGauss(s,b_)
x = (1/(s*sqrt(2*%pi)))*exp(-0.5*(b_/s)^2)
endfunction
Actually, while we're at it, your whole code is really difficult to read. You should define functions instead of repeating code: it helps clarify what you mean, and if there is a mistake, you need to fix only one place. Also, I personally do not recommend that you enclose everything in a function like bla7() because it makes things harder to debug. Your example could be rewritten like this:
The myGauss function;
A function w_ to calculate w1, w2, w10, w20, w100 and w200;
A function c_ to calculate c1, c2, c10, c20, c100 and c200;
A function normal_ to calculate normal1, normal2, normal10, normal20, normal100 and normal200;
Call all four functions as many times as needed with different inputs for different results.
If you do that, your could will look like this:
function x = myGauss(s,b_)
x = (1 / (s * sqrt(2 * %pi))) * exp(-0.5 * (b_/s)^2);
endfunction
function [w1_,w2_] = w_(t_,l_,n_,p_)
w1_ = zeros(t_,1);
w2_ = zeros(t_,1);
for I = 1 : t_
a = (grand(n_,1,"unf",0,p_));
x = l_ * cos(a);
y = l_ * sin(a);
z1 = zeros(n_,1);
z2 = zeros(n_,1);
for i = 2 : n_
z1(i) = z1(i-1) + x(i);
z2(i) = z2(i-1) + y(i);
end
w1_(I) = z1($);
w2_(I) = z2($);
end
endfunction
function [c1_,c2_] = c_(t_,k_,v_,w1_,x_)
c1_ = zeros(k_,1)
for r = 1 : t_
c = w1_(r);
m = -x_ + v_;
n = -x_;
for g = 1 : k_
if (c < m & c >= n) then
c1_(g) = c1_(g) + 1;
m = m + v_;
n = n + v_;
else
m = m + v_;
n = n + v_;
end
end
end
c2_ = zeros(k_,1);
c2_(1) = -x_ + (x_/k_);
for b = 2 : k_
c2_(b) = c2_(b-1) + v_;
end
endfunction
function [normal1_,normal2_,normal3_] = normal_(k_,bb_,bc_,v_,w1_)
y = stdev(w1_);
normal1_ = zeros(k_,1);
normal2_ = zeros(k_,1);
for wa = 1 : k_
bd_ = (bb_ + bc_) / 2;
gauss1 = myGauss(y,bb_);
gauss2 = myGauss(y,bc_);
gauss3 = myGauss(y,bd_);
gauss4 = ((bc_ - bb_) / 6) * (gauss1 + gauss2 + 4 * gauss3);
bb_ = bb_ + v_;
bc_ = bc_ + v_;
normal2_(wa,1) = gauss4;
end
normal3_ = normal2_ * 4000;
endfunction
t = 4000;
l = 0.067;
p = 2 * %pi;
n = 1000;
k = 70;
v = 12 / k;
x = 6;
bb = -x;
bc = -x + v;
[w1,w2] = w_(t,l,n,p);
[c1,c2] = c_(t,k,v,w1,x);
[normal1,normal2,normal3] = normal_(k,bb,bc,v,w1);
bar(c2,c1,1.0,'white');
plot(c2, normal3, 'r-');
n = 10000;
k = 100;
v = 24 / k;
x = 12;
bb = -x;
bc = -x + v;
[w10,w20] = w_(t,l,n,p);
[c10,c20] = c_(t,k,v,w10,x);
[normal10,normal20,normal30] = normal_(k,bb,bc,v,w10);
bar(c20,c10,1.0,'white');
plot(c20, normal30, 'b-');
n = 100;
k = 70;
v = 12 / k;
x = 6;
bb = -x;
bc = -x + v;
[w100,w200] = w_(t,l,n,p);
[c100,c200] = c_(t,k,v,w100,x);
[normal100,normal200,normal300] = normal_(k,bb,bc,v,w100);
bar(c200,c100,1.0,'white');
plot(c200, normal300, 'm-');
poly1.thickness=3;
xlabel(["x / um"]);
ylabel("molecules");
gcf().axes_size=[500,500]
a=gca();
a.zoom_box=[-12,12;0,600];
a.font_size=4;
a.labels_font_size=5;
a.x_label.font_size = 5;
a.y_label.font_size = 5;
ticks = a.x_ticks
ticks.labels =["-12";"-10";"-8";"-6";"-4";"-2";"0";"2";"4";"6";"8";"10";"12"]
ticks.locations = [-12;-10;-8;-6;-4;-2;0;2;4;6;8;10;12]
a.x_ticks = ticks
I use vba on excel 2007, OS: windows vista, to make calculation using kinematic wave equation in finite difference scheme. But, when it runs the run-time 5 (invalid procedure call or arguments) message appears. I really don't what is going wrong. Anyone can help?
Sub kwave()
Dim u(500, 500), yy(500, 500), alpha, dt, dx, m, n, so, r, f, X, L, K As Single
Dim i, j As Integer
dx = 0.1
dt = 0.01
L = 10
m = 5 / 3
r = 1
f = 0.5
n = 0.025
so = 0.1 'this is slope
alpha = 1 / n * so ^ 0.5
X = 0
For i = 0 To 100
Cells(i + 1, 1) = X
u(i, 1) = L - so * X
X = X + dx
Cells(i + 1, 2) = u(i, 1)
Next i
For j = 0 To 100
For i = 1 To 100
'predictor step
u(i, j + 1) = u(i, j) - alpha * dt / dx * (u(i + 1, j) ^ m - u(i, j) ^ m) + (r - f) * dt
'corrector step
K = u(i, j + 1) ^ m - u(i - 1, j + 1) ^ m '<<<<----- RUNTIME ERROR 5 HAPPENS AT THIS LINE
yy(i, j + 1) = 0.5 * ((yy(i, j) + u(i, j + 1)) - alpha * dt / dx * K + (r - f) * dt)
Next i
Next j
End Sub
You are declaring the variables wrong- the array should store a double/single but it is defaulting to a variant. See this article.
http://www.cpearson.com/excel/declaringvariables.aspx -
"Pay Attention To Variables Declared With One Dim Statement
VBA allows declaring more than one variable with a single Dim
statement. I don't like this for stylistic reasons, but others do
prefer it. However, it is important to remember how variables will be
typed. Consider the following code:
Dim J, K, L As Long You may think that all three variables are
declared as Long types. This is not the case. Only L is typed as a
Long. The variables J and K are typed as Variant. This declaration is
functionally equivalent to the following:
Dim J As Variant, K As Variant, L As Long You should use the As Type
modifier for each variable declared with the Dim statement:
Dim J As Long, K As Long, L As Long "
Additionally, when i = 99 and j = 10, u(99,11), which is j+1, produces a negative number. Note that this does not fully cause the problem though, because you can raise negative numbers to exponents. Ex, -5^3 = -125
I was running tests on my software today and found that some of the values it was producing weren't correct.
I decided to step through the code and noticed that the variables I had assigned to textbox values on my userform when hovered over said empty, even though when hovering over the textbox assigned to it, the value inputted by the user showed.
For Example,
n = BiTimeSteps_TextBox.Value
when hovered over
n = empty
even though
BiTimeSteps_TextBox.Value = 2
when hovered over.
So say I have a formula shortly after that says
d = n*2 ,
n when hovered over says empty and d is made 0 when it shouldn't be.
Someone told me if I switch it around to
BiTimeSteps_TextBox.Value = n
it should be recognised but it is still not.
What could possibly be causing this?
See full code below: (it aims to price options using the binomial tree pricing method)
S = BiCurrentStockPrice_TextBox.Value
X = BiStrikePrice_TextBox.Value
r = BiRisk_Free_Rate_TextBox.Value
T = BiexpTime_TextBox.Value
Sigma = BiVolatility_TextBox.Value
n = BiTimeSteps_TextBox.Value
Dim i, j, k As Integer
Dim p, V, u, d, dt As Double
dt = T / n ' This finds the value of dt
u = Exp(Sigma * Sqr(dt)) 'formula for the up factor
d = 1 - u 'formula for the down factor
'V value of option
'array having the values
Dim bin() As Double 'is a binomial arrays, it stores the value of each node, there is a loop
'work out the risk free probability
p = (1 + r - d) / (u - d)
'probability of going up
ReDim bin(n + 1) As Double
'it redims the array, and n+1 is used because it starts from zero
'------------------------------------------------------------------------------------------------------------------------------
''European Call
If BiCall_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, (u ^ (n - i)) * (d ^ i) * S - X)
'It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
'european put
If BiPut_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, X - (S * (u * (n - i)) * (d * i)))
' European Put- It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
For k = 1 To n 'backward column loop
For j = 1 To (n - k + 1) 'loop down the column loop
bin(j) = (p * bin(j) + (1 - p) * bin(j + 1)) / (1 + r)
Cells(j + 19, n - k + 2) = bin(j)
'' print the values along the column, view of tree
Next j
Next k
Worksheets("Binomial").Cells(17, 2) = bin(1) ' print of the value V
BiOptionPrice_TextBox = bin(1)