تبدیل یه برنامه به زبان فرترن به زبان ...

[متالیک]

سلام
از دوستان کسی می تونه این برنامه رو به زبان basic یا pascal یا c یا matlab تبدیلش کنه؟


برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید

[bad_boy_2007]

سلام
از دوستان کسی می تونه این برنامه رو به زبان basic یا pascal یا c یا matlab تبدیلش کنه؟


برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید

اگه ممکنه توضیح بدی این برنامه چه کاری انجام میده و اگر هم با سینتکس فرترن آشنایی داری کمی در مورد اونچه که میدونی توضیح بده تا دوستان بهتر بتونن کمکت کنن

[متالیک]

دوست عزیز
من با برنامه فرترن آشنایی ندارم اگه داشتم سریعا خودم این کار را می کردم.
الانش هم می تونم، مشکل من فقط تو این چند تا خطه:

implicit double precision (a-h, k, o-z)
parameter (iz=100)
dimension aa(0:iz), bb(0:iz), cc(0:iz), dd(0:iz)
dimension tmj(0:iz), tm(0:iz)

zl = 2.d0
tl = 3600.d0*24.d0
np = 80
dt = 1.0d0
dift = 6.d-7
t0 = 15.d0
tnp = 25.d0
tini = 16.d0
t = 0.d0
dz = zl/dble(np)
rz = dift*dt/(dz*dz)
rz2 = 1.d0 + 2.d0*rz

[hsriahi2]

سلام
دوست عزیز من می تونم تبدیلش کنم .به ویژوال بیسیک یا بیسیک یا متلب.
با این شماره بزنگ:09134910481

[hsriahi2]

سلام
دوست عزیز من می تونم تبدیلش کنم .به ویژوال بیسیک یا بیسیک یا متلب.
با این شماره بزنگ:09134910481
[ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ] [ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ] ([ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ]) [ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ] [ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ] ([ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ])

[hsriahi2]

سلام
از دوستان کسی می تونه این برنامه رو به زبان basic یا pascal یا c یا matlab تبدیلش کنه؟


برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید
سلام
دوست عزیز من می تونم تبدیلش کنم .به ویژوال بیسیک یا بیسیک یا متلب.
با این شماره بزنگ:09134910481
[ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ] [ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ] ([ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ]) [ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ] [ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ] ([ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ])

[hsriahi2]

سلام بچه های ما می تونند تبدیلش کنند با این شماره بتلفن:09134810481

[godarzr]

سلام
منم این مشکل و دارم
کسی هست حلش کنه؟
subroutine HLL11

use Unstructured_var

implicit doubleprecision (a-h,o-z)

dc = 0
dp = 0
dq = 0

call OneDParam

!*************full_1d continuty*****************


do l=1,NumRiver


Rivers(l)%dh1(:) = 0
Rivers(l)%dQ1(:) = 0
Rivers(l)%dQ12(:) = 0


end do

do l=1,NumRiver
Nend = Rivers(l)%NumNode

!---------------------------------------- Q-BC
if (Rivers(l)%Bc_Up .eq. 'Q') then
Rivers(l)%dh1(1 ) = Rivers(l)%dh1(1 ) + Rivers(l)%BcVal_Up
end if
if (Rivers(l)%Bc_Down .eq. 'Q') then
Rivers(l)%dh1(Nend) = Rivers(l)%dh1(Nend) - Rivers(l)%BcVal_Down
end if

!---------------------------------------- Q-BC Inside Boundary Conditions
if (Rivers(l)%Bc_Up .eq. 'Inside') then
Ir = Rivers(l)%Ins_Bc_Up_Riv
In = Rivers(l)%Ins_Bc_Up_Node
Rivers(Ir)%dh1(In ) = Rivers(Ir)%dh1(In ) - Rivers(l)%Q1d(2)
end if
if (Rivers(l)%Bc_Down .eq. 'Inside') then
Ir = Rivers(l)%Ins_Bc_Down_Riv
In = Rivers(l)%Ins_Bc_Down_Node
Rivers(Ir)%dh1(In ) = Rivers(Ir)%dh1(In )+Rivers(l)%Q1d(Nend-1)
end if
!----------------------------------------
do i=2,Nend

i1 = i - 1
i2 = i
n1 = Rivers(l)%Node(i1)
n2 = Rivers(l)%Node(i2)


ar1 = Rivers(l)%area(i1) + 0.000001
ar2 = Rivers(l)%area(i2) + 0.000001

tr1 = Rivers(l)%T(i1) + 0.000001
tr2 = Rivers(l)%T(i2) + 0.000001

hl = max(min(z(n1) - Rivers(l)%z1d(i1), Rivers(l)%h1d(i1)),0.)
hr = max(min(z(n2) - Rivers(l)%z1d(i2), Rivers(l)%h1d(i2)),0.)
h2l= max(Rivers(l)%eta1d(i1) - z(n1),0.)
h2r= max(Rivers(l)%eta1d(i2) - z(n2),0.,0.)


hl = (ar1 + tr1 * h2l) / tr1
hr = (ar2 + tr2 * h2r) / tr2




Ql = Rivers(l)%Q1d(i1)
Qr = Rivers(l)%Q1d(i2)

Ul = Rivers(l)%Q1d(i1) / ar1
Ur = Rivers(l)%Q1d(i2) / ar2

cl = (g * hl) ** .5
cr = (g * hr) ** .5

hstar = 1 / g * ((cl + cr) * .5 + (Ul - Ur) * .25) ** 2

if (hstar.gt.hl) then
Ql1 = sqrt(.5 * (hstar + hl) * hstar / (hl ** 2. + .0001))
else
Ql1 = 1
end if

if (hstar.gt.hr) then
Qr1 = sqrt(.5 * (hstar + hr) * hstar / (hr ** 2. + .0001))
else
Qr1 = 1
end if

if (hl.eq.0) then
sl = Ur - 2 * cr
sr = Ur + cr * Qr1
else if (hr.eq.0) then
sl = Ul - cl * Ql1
sr = Ul + 2 * cl
else
sl = Ul - cl * Ql1
sr = Ur + cr * Qr1
end if




if (Rivers(l)%Junc(i1) > 0 ) then
Ql = Qr
endif
if (Rivers(l)%Junc(i2) > 0 ) then
Qr = Ql
endif



if (sl.ge.0) then ! up stream super critical


fs1 = Ql

else if (sr.le.0) then ! down stream super critical


fs1 = Qr

else if (sl.le.0.and.sr.ge.0) then


t1 = sr - sl

fs1 = (sr * Ql - sl * Qr + sl * sr * (hr - hl)) / t1

end if



if (Rivers(l)%eta1d(i1) .gt. z(n1)+.01) then
dc(n1) = dc(n1) - fs1
else
Rivers(l)%dh1(i1) = Rivers(l)%dh1(i1) - fs1
end if
if (Rivers(l)%eta1d(i2) .gt. z(n2)+.01) then
dc(n2) = dc(n2) + fs1
else
Rivers(l)%dh1(i2) = Rivers(l)%dh1(i2) + fs1
end if

end do
end do


!*************1d momentum*****************


do l=1,NumRiver
Nend = Rivers(l)%NumNode
do i=2,Nend

i1 = i - 1
i2 = i
n1 = Rivers(l)%Node(i1)
n2 = Rivers(l)%Node(i2)


ar1 = Rivers(l)%area(i1) + 0.000001
ar2 = Rivers(l)%area(i2) + 0.000001

tr1 = Rivers(l)%T(i1) + 0.000001
tr2 = Rivers(l)%T(i2) + 0.000001


hl = max(min(z(n1) - Rivers(l)%z1d(i1), Rivers(l)%h1d(i1)),0.)
hr = max(min(z(n2) - Rivers(l)%z1d(i2), Rivers(l)%h1d(i2)),0.)



h2l= max(Rivers(l)%eta1d(i1) - z(n1),0.)
h2r= max(Rivers(l)%eta1d(i2) - z(n2),0.,0.)


hl = (ar1 + tr1 * h2l) / tr1
hr = (ar2 + tr2 * h2r) / tr2




Ql = Rivers(l)%Q1d(i1)
Qr = Rivers(l)%Q1d(i2)

Ul = Ql / ar1
Ur = Qr / ar2

cl = (g * hl) ** .5
cr = (g * hr) ** .5

hstar = 1 / g * ((cl + cr) * .5 + (Ul - Ur) * .25) ** 2

if (hstar.gt.hl) then
Ql1 = sqrt(.5 * (hstar + hl) * hstar / (hl ** 2. + .0001))
else
Ql1 = 1
end if

if (hstar.gt.hr) then
Qr1 = sqrt(.5 * (hstar + hr) * hstar / (hr ** 2. + .0001))
else
Qr1 = 1
end if

if (hl.eq.0) then ! Up stream dry
sl = Ur - 2 * cr
sr = Ur + cr * Qr1
else if (hr.eq.0) then ! down stream dry
sl = Ul - cl * Ql1
sr = Ul + 2 * cl
else
sl = Ul - cl * Ql1
sr = Ur + cr * Qr1
end if



if (sl.ge.0) then


fs2 = Ql * Ul
else if (sr.le.0) then


fs2 = Qr * Ur


else if (sl.le.0.and.sr.ge.0) then


fln2 = Ql * Ul
frn2 = Qr * Ur

t1 = sr - sl

fs2 = (sr * fln2 - sl * frn2 + sl * sr * (Qr - Ql)) / t1


end if



if (i .gt. 2 )
& Rivers(l)%dQ1(i1) = Rivers(l)%dQ1(i1) - fs2
if (i .lt. Nend)
& Rivers(l)%dQ1(i2) = Rivers(l)%dQ1(i2) + fs2


end do
end do

!******************************************** Computation of final 1d Q and Y
do l=1,NumRiver
Nend = Rivers(l)%NumNode
do i=1,Nend
n1 = Rivers(l)%Node(i)
Area = Rivers(l)%area(i)
rad = Rivers(l)%Radus(i)
xm = Rivers(l)%m(i)
tr = Rivers(l)%T(i) + 0.0001
eta0 = Rivers(l)%eta1d(i)
!----------------------------------------------- h1d = h1d + dh1d
Rivers(l)%h1d(i) = Rivers(l)%h1d(i)
& + (Rivers(l)%dh1(i) + Rivers(l)%dQ12(i))/tr/Rivers(l)%dx1d(i)*dt
!-----------------------------------------------
if (Rivers(l)%h1d(i).gt.Rivers(l)%h1dmax(i)) then
Rivers(l)%h1d(i) = Rivers(l)%h1dmax(i)
end if
!----------------------------------------------- Q1d = Q1d + dQ1d
Rivers(l)%Q1d(i) = Rivers(l)%Q1d(i)
& + Rivers(l)%dQ1(i) * dt / Rivers(l)%dx1d(i)


if (i == 1) then
dis1 = Rivers(l)%dis(i + 1)
i2 = i + 1
dedx = (Rivers(l)%eta1d(i2) - Rivers(l)%eta1d(i)) / dis1
dAdx = (Rivers(l)%area(i2) - Rivers(l)%area(i)) / dis1

else if (i == Nend) then
dis1 = Rivers(l)%dis(i)
i1 = i - 1
dedx = (Rivers(l)%eta1d(i) - Rivers(l)%eta1d(i1)) / dis1
dAdx = (Rivers(l)%area(i) - Rivers(l)%area(i1)) / dis1

else

i2 = i + 1
etad = (Rivers(l)%eta1d(i2) + Rivers(l)%eta1d(i))*0.5

i1 = i - 1
etau = (Rivers(l)%eta1d(i) + Rivers(l)%eta1d(i1))*0.5

dedx = (etad - etau) / Rivers(l)%dx1d(i)


dAdx =.5*(Rivers(l)%area(i2)- Rivers(l)%area(i1))
& / Rivers(l)%dx1d(i)


end if
Rivers(l)%Q1d(i) = Rivers(l)%Q1d(i) - g * Area * dt * dedx
sf0 = abs(Rivers(l)%Q1d(i))*xm * xm /(Area * Area* rad **(1.33))
Rivers(l)%Q1d(i) = Rivers(l)%Q1d(i) / (1 + sf0 * dt * g * Area)
end do
end do
!*************1d Boundary Condition******
do l=1,NumRiver
Nend = Rivers(l)%NumNode
if (Rivers(l)%Bc_Up .eq. 'Q') then
Rivers(l)%Q1d(1) = Rivers(l)%Bcval_Up
elseif (Rivers(l)%Bc_Up .eq. 'Level') then
Rivers(l)%h1d(1) = Rivers(l)%Bcval_Up - Rivers(l)%z1d(1)
elseif (Rivers(l)%Bc_Up .eq. 'Inside') then
Ir = Rivers(l)%Ins_Bc_Up_Riv
In = Rivers(l)%Ins_Bc_Up_Node
Rivers(l)%h1d(1) = Rivers(Ir)%eta1d(In) - Rivers(l)%z1d(1)
Rivers(l)%h1d(1) = min(Rivers(l)%h1d(1),Rivers(l)%h1dmax(1))
end if
if (Rivers(l)%Bc_Down .eq. 'Q') then
Rivers(l)%Q1d(Nend) = Rivers(l)%Bcval_Down
elseif (Rivers(l)%Bc_Down .eq. 'Level') then
Rivers(l)%h1d(Nend) = Rivers(l)%Bcval_Down - Rivers(l)%z1d(Nend)
elseif (Rivers(l)%Bc_Down .eq. 'Inside') then
Ir = Rivers(l)%Ins_Bc_Down_Riv
In = Rivers(l)%Ins_Bc_Down_Node
Rivers(l)%h1d(Nend)= Rivers(Ir)%eta1d(In) - Rivers(l)%z1d(Nend)
Rivers(l)%h1d(Nend)=min(Rivers(l)%h1d(Nend),Rivers (l)%h1dmax(Nend))
end if
end do
end