アプリ版:「スタンプのみでお礼する」機能のリリースについて

以下のgo to文で書かれたプログラムをdoループのプログラムに書き直したいのですがどのように直してよいかわかりません。どなたかわかる方がいらっしゃったら教えて下さい。よろしくお願いします。

subroutine fft_eth(n,cx,icon,irr)
implicit none
integer :: n, m, ii, l, lb, llb, k, kl, kb, klb, &
j, jl, jl2, jlb, jb, jb2, jb4, jj, j1, j2, jjb, jf1, jf2, jff, jf
real(8) :: fn, ff, fkl, fjl, fm, ffm, fklb, fjlb, th, th2, st, tt
real(8) :: icon
real(8) :: irr
complex(8) :: ct, cu, ca, cx, cuc
dimension cx(n)
real(8), parameter :: pi = 3.141592653589793238462643d0

if(n < 2) go to 900
fn = n
m = idnint(dlog(fn)/dlog(2.0d0))
ii = 2**m-n
if(ii /= 0) go to 910

do 50 l = 1, m
kl = 2**(l-1)
fkl =kl
fjl = 0.5d0*fn/fkl
jl = fjl
jl2 = 2*jl
th = 2.0d0*pi*fkl/fn
th2 = 0.5d0*th
st = dsin(th)
tt = -2.0d0*dsin(th2)*dsin(th2)
ct = dcmplx(tt,st)

do 40 k = 1, kl
jj = jl2*(k-1)
cu = (1.0d0,0.0d0)

do 30 j = 1, jl
j1 = j+jj
j2 = j1+jl
ca = cx(j1)-cx(j2)

if(icon < 0) go to 10

cuc = dconjg(cu)
cx(j2) = ca*cuc
go to 20

10 continue
cx(j2) = ca*cu
20 continue
cu = cu+cu*ct
30 continue
40 continue
50 continue

!=================
! BIT REVERSAL
!=================
fm = m
ffm = 0.5d0*fm
llb = ffm

do 80 lb = 1, llb
klb = 2**(lb-1)
fklb =klb
fjlb = 0.25d0*fn/fklb
jlb = fjlb
jb2 = 2*jlb
jb4 = 4*jlb

do 70 kb = 1, klb
jjb = jb4*(kb-1)
jf1 = jjb+klb
jf2 = jjb+jb2

do 60 jb = 1, jlb
ff = jb-1
ff = ff/fklb
jff = ff
jf = jb+jff*klb
j1 = jf+jf1
j2 = jf+jf2
ct = cx(j1)
cx(j1) = cx(j2)
cx(j2) = ct
60 continue
70 continue
80 continue

!=======================
! ERROR CONDITION CODE
!=======================
irr = 0
return
900 continue
irr = -1
return
910 continue
irr = -2
return

end subroutine

A 回答 (3件)

subroutine fft_eth(n,cx,icon,irr)


implicit none
integer :: n, m, ii, l, lb, llb, k, kl, kb, klb, &
j, jl, jl2, jlb, jb, jb2, jb4, jj, j1, j2, jjb, jf1, jf2, jff, jf
real(8) :: fn, ff, fkl, fjl, fm, ffm, fklb, fjlb, th, th2, st, tt
real(8) :: icon
real(8) :: irr
complex(8) :: ct, cu, ca, cx, cuc
dimension cx(n)
real(8), parameter :: pi = 3.141592653589793238462643d0

if(n < 2) then
fn = n
m = idnint(dlog(fn)/dlog(2.0d0))
ii = 2**m-n
irr = -1
return
else if(ii /= 0) then
irr = -2
return
else
end if

do l = 1,m
kl = 2**(l-1)
fkl =kl
fjl = 0.5d0*fn/fkl
jl = fjl
jl2 = 2*jl
th = 2.0d0*pi*fkl/fn
th2 = 0.5d0*th
st = dsin(th)
tt = -2.0d0*dsin(th2)
do k = 1,kl
jj = jl2*(k-1)
cu = (1.0d0,0.0d0)
do j = 1,jl
j1 = j+jj
j2 = j1+jl
ca = cx(j1)-cx(j2)
if(icon < 0) then
cx(j2) = ca*cu
else
cuc = dconjg(cu)
cx(j2) = ca*cuc
end if
cu = cu+cu*ct
end do
end do
end do

irr = 0

end subroutine

こうゆうことですか?
    • good
    • 0
この回答へのお礼

わざわざプログラムを書いて下さってありがとうございました。参考になります。

お礼日時:2010/01/28 12:00

do 100 i = 1,10


j = j+1
if( j>5 ) goto 110
100 continue
110 continue

この程度なら直せるんですか?
do-enddoで直せるところを全て直し、
if文で微妙なところに飛んでいる場所を個別に直していくといいかと。

do i = 1,10
j = j+1
if( j>5 ) exit
enddo

直したコードをここに書くのに意味がないかと思い、この程度で。
    • good
    • 0
この回答へのお礼

はい、大体はdoループの文に直せました。ありがとうございました。

お礼日時:2010/01/28 12:02

なぜ「以下のgo to文で書かれたプログラムをdoループのプログラムに書き直したい」と思ったのでしょうか? そして, 具体的にはど

この go to文を doループで書きなおしたいのですか?
    • good
    • 0
この回答へのお礼

ただ、他のプログラムが全てdoループ文で、今回の文もdoループ文に統一したかったもので。do to 文でも問題はなかったです。ご回答ありがとうございました。

お礼日時:2010/01/28 12:05

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!