• ベストアンサー

fortran go to 文

以下の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

質問者が選んだベストアンサー

  • ベストアンサー
noname#104778
noname#104778
回答No.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 こうゆうことですか？

528612
質問者

お礼

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

その他の回答 (2)

  • --HV--
  • ベストアンサー率25% (5/20)
回答No.2

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 直したコードをここに書くのに意味がないかと思い、この程度で。

528612
質問者

お礼

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

  • Tacosan
  • ベストアンサー率23% (3656/15482)
回答No.1

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

528612
質問者

お礼

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

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. その他（プログラミング・開発）

関連するQ&A

  • Fortranについて質問です。

    プログラムソースの中で ----------------------- Real*8 A(10,10) Do 30 i = 1, 5 Do 40 j = 1,5 A(i,j)=0.0D0 40 Continue 30 Continue ------------------------ というのは、 配列A(i,j)にどんな値を入れるのですか？ すべて0が入るということですか？ 教えてください＞＜

  • fortranで・・・

    実行の画面に数字を入力すると、 英語の文章と 0.0 0.0 0.0 -NaN -NaN -NaN という文字が出てくるだけなんですが、これはプログラムが組めていないということなのでしょうか？ ちなみに、打ったプログラムは、 C 判別関数 WRITE(*,100) 100 FORMAT(1H1/22X,'判別関数モデル'//19X,'消費量',3X,'消費比率'//19X, +'清酒',5X,'焼酎',5X,'ビール',7X,'清酒',6X,'ビール',7X,'M'10X,'D'/ +/) DO 10 I=1,47 CALL SUB1 10 CONTINUE STOP END SUBROUTINE SUB1 DIMENSION B1(3),B2(3),C(3),L(3),P(3) CHARACTER*12 A READ(5,50) A 50 FORMAT(3F8.1,3F7.1) X=1.0 DO 11 K=1,300 Y1=(-1.0) Y2=0.0 DO 12 J=1,3 B2=0.0 B1=0.0 L(J)=(-NINT(B1(J)*10.0/B2(J))) S1=Y1+X**L(J) S2=Y2+L(J)*X**(L(J)-1) Y1=S1 Y2=S2 12 CONTINUE W=X-Y1/Y2 IF(ABS(W-X).LT.1E-10) GO TO 13 X=W 11 CONTINUE 13 WO=W DO 14 J=1,3 C(J)=WO**L(J) 14 CONTINUE R1=0.0 DO 15 J=1,3 R2=R1+B2(J) R1=R2 15 CONTINUE D=0.0 DO 16 J=1,3 P(J)=B2(J)/R1 DO=D+P(J)*ALOG(P(J)/C(J)) D=DO 16 CONTINUE E=0.0 DO 17 J=1,3 EO=E+(B1(J)/B2(J)*P(J)) E=EO 17 CONTINUE WRITE(*,200) A,B2,P,E,D 200 FORMAT(1H,2X,A12,3X,3(F7.1,2X),4X,3(F9.6,X),4X,F9.6,2X,F9.6) RETURN END です。

  • FORTRAN…これってどんなプログラムになりますか？？

    DO 10 I=1,47 CALL SUB1 10 CONTINUE STOP END SUBROUTINE SUB1 DIMENSION B1(3),B2(3),C(3),L(3),P(3) CHARACTER*12 A READ(5,50) A,B1,B2 50 FORMAT(A12,3F8.1,3F7.1) X=1.0 DO 11 K=1,300 Y1=(-1.0) Y2=0.0 DO 12 J=1,3 L(J)=(-NINT(B1(J)*10.0/B2(J))) Y1=Y1+X**L(J) Y2=Y2+L(J)*X**(L(J)-1) 12 CONTINUE W=X-Y1/Y2 IF(ABS(W-X).LT.1E-10) GO TO 13 X=W 11 CONTINUE 13 WO=W DO 14 J=1,3 C(J)=WO**L(J) 14 CONTINUE R1=0.0 DO 15 J=1,3 R2=R1+B2(J) R1=R2 15 CONTINUE D=0.0 DO 16 J=1,3 P(J)=B2(J)/R1 D=D+P(J)*ALOG(P(J)/C(J)) 16 CONTINUE E=0.0 DO 17 J=1,3 E=E+(B1(J)/B2(J)*P(J)) 17 CONTINUE WRITE(*,200) A,B2,P,E,D 200 FORMAT(1H,2X,A12,3X,3(F7.1,2X),4X,3(F9.6,X),4X,F9.6,2X,F9.6) RETURN END

  • Fortranについて教えてください！

    こんにちわ。 ヤマといいます。 以下について教えて頂けないでしょうか？ ------------------- 途中省略 ------------------- DO 31 I = 1,NCARDS LC = LC + 1 READ(8,FMAT) (XR(J), J=1,NPL) IF(I.NE.NCARDS) GO TO 6 IF(JL.EQ.0) GO TO 6 JL=NPL+1-JL DO 5 J=JL,NPL 5 XR(J)=0. C--------------------------------------------------------------- C ONLY PRINT OUT A FEW OF THE FIRST AND THE LAST LINES of Input Motion C--------------------------------------------------------------- 6 ICHECK = NCARDS - I IF (I .LE. 5 .OR. ICHECK .LT. 5) WRITE(6,2008) I,(XR(J), J=1,NPL) IF (I .EQ. 10) WRITE (6,2009) 2009 FORMAT(3X,'........ INPUT MOTION READ NOT ECHOED...........') C ENDIF C C FIND MAX. INPUT ACC. (XMAX) C 311 DO 31 J = 1,NPL,2 N = N + 1 X(N) = CMPLX(XR(J),XR(J+1)) 31 CONTINUE ........................................... とあります。 いま、XRは、 ----------------データ------------------------ -0.001694 -0.001668 -0.000086 -0.001356 -0.000678 0.000700 -0.001209 -0.000604 ・・・・・・・・・・・・・・・・・・・・・ ----------------データ------------------------ と1行に8列分のデータが存在します。 ソース中に「CMPLX(XR(J),XR(J+1))」とあります。 この意味がよく分かりません。通常だと実部にXR(J),虚部 にXR(J+1)を入れるというように解釈できるのですが、 本当でしょうか？ご存知の方ご意見よろしくお願いいたします。

  • FortranのGO TO文について。

    Fortranのプログラムソースで 90 CONTINUE IF (式) GO TO 100 DO 110…[略] 110 CONTINUE 100 CONTINUE IF (式) THEN DO 120…[略] 120 CONTINUE GO TO 90 のような場合どのように処理が進んでいくのですか？ 「GO TO(行番号)」で指定された行番号で戻った先が「（行番号）CONTINUE」の場合、 その次の行からの処理を行うのですか？

  • Fortran77のプログラム実行時にエラー

    Windows98でCPad for Salford FTN77というソフトを使って、Fortran77のプログラミングをしています。そこで学校での課題で、下のようなプログラムを作ったのですが、実行すると次のようなエラーがでます。 The insrtuction at address 0373f5b0 attempted to read from an illegal location 0373f5b0 routine at address 373F5B0 [+0000] 00401000 main [+074f] で、ファイルに書き込めてるかどうかチェックすると、何も書き込めていません。どうすれば、ちゃんと動くのでしょうか。どなたか分かる方、宜しくお願いします。 プログラム↓ *生徒50人の成績を読み込み平均点などを計算し、ファイルに書き込む PROGRAM GOKAMOKU HEIKIN INTEGER N(1:50),EP(1:50),MP(1:50),JP(1:50),SP(1:50),CP(1:50) INTEGER SUM(1:50),K,I,L,J,M,Q REAL PAV(1:50),PVX(1:50),PSD(1:50),EAV,ESD,MAV,MSD,JAV,JSD REAL SAV,SSD,CAV,CSD CHARACTER FNAME*30,SHUTURYOKU*20,CN*50,SHUTURYOKU2*20 READ(5,*)FNAME READ(5,*)SHUTURYOKU OPEN(1,FILE=FNAME) DO 10 K=1,50 READ(1,*)N(K),EP(K),MP(K),JP(K),SP(K),CP(K) 10 CONTINUE CLOSE(1) *英語の平均点、標準偏差の計算 OPEN(2,FILE=SHUTURYOKU) CALL AVEETC(EP,EAV,ESD) WRITE(2,*)'英語の平均点・標準偏差' WRITE(2,300) EAV,ESD 300 FORMAT(2F6.2) *数学の平均点、標準偏差の計算 CALL AVEETC(MP,MAV,MSD) WRITE(2,*)'数学の平均点・標準偏差' WRITE(2,300) MAV,MSD *国語の平均点、標準偏差の計算 CALL AVEETC(JP,JAV,JSD) WRITE(2,*)'国語の平均点・標準偏差' WRITE(2,300) JAV,JSD *理科の平均点、標準偏差の計算 CALL AVEETC(SP,SAV,SSD) WRITE(2,*)'理科の平均点・標準偏差' WRITE(2,300) SAV,SSD *社会の平均点、標準偏差の計算 CALL AVEETC(CP,CAV,CSD) WRITE(2,*)'社会の平均点・標準偏差' WRITE(2,300) CAV,CSD *各生徒の合計点、平均点、標準偏差の計算 DO 50 K=1,50 SUM(K)=EP(K)+MP(K)+JP(K)+SP(K)+CP(K) PVX(K)=EP(K)**2+MP(K)**2+JP(K)**2+SP(K)**2+CP(K)**2 PAV(K)=REAL(SUM(K))/5.0 PSD(K)=SQRT(PVX(K)/5.0-PAV(K)**2) 50 CONTINUE WRITE(2,*)'各生徒の合計点、平均点、標準偏差' WRITE(2,*)'番号 合計 平均点 標準偏差' DO 60 K=1,50 WRITE(2,200)K,SUM(K),PAV(K),PSD(K) 60 CONTINUE 200 FORMAT(I3,I5,2F10.2) *合計点のヒストグラムを書く DO 70 J=0,9 JL=10*J JH=JL+9 CALL STR(SUM(J),CN) WRITE(2,400)JL,JH,CN 70 CONTINUE 400 FORMAT(1X,I2,'-',I2,'I',A50) *英語の点数順に並べ変え DO 20 L=1,49 DO 30 I=L+1,50 IF(EP(L).LT.EP(I)) THEN M=EP(I) EP(I)=EP(L) EP(L)=M Q=N(I) N(I)=N(L) N(L)=Q END IF 30 CONTINUE 20 CONTINUE *表示 WRITE(2,*)'英語の成績高い順' WRITE(2,*)'番号 点数' DO 40 J=1,50 WRITE(2,100)N(J),EP(J) 40 CONTINUE 100 FORMAT(I2,I3) END SUBROUTINE AVEETC(P,AV,SD) REAL AV,SD INTEGER P(1:50) WX=0.0 VX=0.0 DO 10 K=1,50 WX=WX+P(K) VX=VX+P(K)*P(K) 10 CONTINUE AV=REAL(WX)/50.0 SD=SQRT(REAL(VX)/50.0-AV**2) END SUBROUTINE STR(SUM,C) INTEGER SUM CHARACTER C*50 DO 10 K=1,50 IF(K.LE.SUM(K))THEN C(K:K)='*' ELSE C(K:K)=' ' END IF 10 CONTINUE END

  • FORTRANでのプログラミングについて

    学校で下記のカッコ内を埋めなければいけないのですが、まったく分からなくて困っています。どなたか教えてくださいませんか？下のプログラムが分かりにくくてごめんなさい。 年賀はがきの当選番号（下二ケタ）5本を配列に登録しておき、コンソールから年賀はがきの下二桁の数字を入力するたびに、あたりはずれを返すプログラムを書きなさい。 登録用当選番号 07　12　35　46　77 1.配列に登録するというのは代入しておくことです。 2.入力は下２けたのみの入力とする 3.999を入力したら終了することとする 4.あたり・はずれは画面に表示すればよい 5.入力されたデータが5つの配列と同じかどうかを 比較して、同じ場合にはあたりを表示する命令文に とぶ。 6.あたりを表示したらデータ入力にもどる 7.同じ数値が無い場合は、はずれと表示してデータ 入力にもどる プログラム integer d(5),i,j,n d(1)=7 d(2)=12 d(3)=35 d(4)=46 d(5)=77 20 ( ) ( ) go to 40 do 10 ( ) if(d(i).eq.n) then write(6,*) ( ) go to 20 end if 10 continue write(6,*) ( ) go to 20 40 stop end

  • フィックの第二法則の刻み時間（フォートラン）

    第二法則について数値解析を行い、 フォートランによって dt=1.0 dx=1e-4 d=2e-12 a=d*dt/(dx)**2 do 300 j=0,3600 c(j,0)=0.0 c(j,20)=2.0 do 400 i=1,19 c(j+1,i)=c(j,i)+a*(c(j,i+1)-2.0*c(j,i)+c(j,i-1)) 400 continue 300 continue として一秒ごとに計算し、一時間後までの各時間、各位置の濃度を求めています。 （jは時間、iは位置を表しています。） このとき、刻み時間t＝１として計算しているのですが、これを0.1秒で計算したいとき、 do 300 j=0,3600 を do 300 j=0,3600,0.1 c(j+1,i) は c(j+0.1,i) としなくてはいけないのでしょうか？ それとも１のままでよいのでしょうか。 どなたか、どうか教えてください。 ちなみに、上のようにかえてもプログラムが通らないことはわかっています。 聞きたいのは、「刻み時間を変えると濃度計算の中身と計算のステップも変えなくてはいけないのか」ということです。 わかりにくくて申し訳ありません。 どうかお願い致します。

  • Excel VBA ExecuteExcel4Macroについて

    こんにちは。よろしくお願いします。 あるフォルダ"D:\test"のなかに、４つのxlsファイル"o.xls"、"a.xls"、"b.xls"、"c.xls"があるとします。 使用するシート名は、それぞれo,a,b,c（ファイル名から".xls"を除いたもの）とします。 このとき"o.xls"を開いて、下記のマクロを実行すると、１行目にパス名、２行名にファイル名、３行目以下に（１列目は"a.xls"の、２列目は"b.xls"の、３列目は"c.xls"の）セルA3以下が読み込まれます。 たとえば、結果は添付の図のようになります。図がうまくアップできなかったらごめんなさい。 Sub sample1() Application.Calculation = xlManual Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next Worksheets("o").Cells.Clear Dim p As String, fn As String, fc As Long, i As Long, j As Long, d, e p = ActiveWorkbook.Path fn = Dir(p & "\" & "*.xls", 0) fc = 0 If fn <> "" Then fc = fc + 1 For j = 3 To 6 With Worksheets("o") .Cells(1, fc).Value = p & "\" & fn .Cells(2, fc).Value = fn d = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & j & "C1") If d = 0 Or IsError(d) Then Exit For Else .Cells(j, fc) = d End If End With Next j End If Do fn = Dir() If fn <> "" Then fc = fc + 1 For i = 3 To 6 With Worksheets("o") .Cells(1, fc).Value = p & "\" & fn .Cells(2, fc).Value = fn e = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & i & "C1") If e = 0 Or IsError(d) Then Exit For Else .Cells(i, fc) = e End If End With Next i Else Exit Do End If Loop Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlAutomatic End Sub 上記の例は変数iとjが3から6までしか動きませんし、読み込むxlsファイルも３つしかありませんのですぐに終わりますが、実際には行やファイルがもっとたくさんあり、非常に時間がかかっています。そこで、 ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & i & "C1") を e = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R3C1:R6C1") というような風にして、For～Nextも使用せず .range(Cells(3, fc),cells(6, fc)) = e というふうに範囲で読み込もうとしたのですがうまくいきません。 ExecuteExcel4Macroは範囲を読み込むことはできないのでしょうか？ 何とかして処理速度を上げたいのですが、どうすればよいでしょうか。

  • ｐｈｐ言語にて

    <?php print "<form><table border=\"1\" cellpadding=\"5\">\n"; for($i=0;$i<6;$i++){ if($i==0){print "<tr><td>&nbsp;</td><th>月曜日</th><th>火曜日</th><th>水曜日</th><th>木曜日</th><th>金曜日</th></tr>\n"; continue; } print "<tr><td align=\"center\">$i<br>限</td>"; for($j=1;$j<6;$j++){ print "<td><select name=\"kamoku$j$i\"><option value=\"\"> <option value=\"科目A\">科目 A<option value=\"科目B\">科目 B<option value=\"科目C\">科目 C<option value=\"科目D\">科目 D<option value=\"科目E\">科目 E<option value=\"科目F\">科目 F<option value=\"未定\">未定 </select> </td>"; } print "</tr>\n"; } print "</table>\n</form>"; ?> これにボタンを付けて、ボタンを押したら操作をできなくするにはどうすればいいですか？ 保存のような機能を付けたいのですが… なにか参考になるサイトはありませんか？

    • 締切済み
    • PHP

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する