フォートランで、ある関数f(x)の最大値と最小値を求めたいのですがうまく出来ません。最大値と最小値のみを表示させたいのですが、下の文をどうにかして出来ないでしょうか?どなたかお願いします。

x=0
do
x=x+0.1
if(x>10) stop
y=f(x)
write(6,10) x,y
end do
10 format(' ',f5.2,5x,f10.5)
end

A 回答 (1件)

今まで10回も質問を出されたのに、


サンクスポイントは一度も出していないのですね...。
答えくれくれ君じゃなくて、
少しくらいお礼もしたらどうですか。
不等号も使えるFortranみたいなので、マネしときます。

max = f(0.0)
min = f(0,0)
if(max<y) max = y
if(min>y) min = y
write(6,20) max,min

あと、20行にformat命令が必要ですが、
そこは自分で考えてください。
    • good
    • 0
この回答へのお礼

サンクスポイントって何ですか?
質問締め切って、良回答を選ぶやつじゃないんですか??
それならしてますけど!?
まだ回答待ってるのもありますが・・

とにかく回答ありがとうございます。
f(0,0)っての良く分かりませんが、自分で調べてみます。

お礼日時:2001/07/24 00:04

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

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q配列Xの最大値、最小値を求めるサブルーチンmaxminの作り方

配列Xに入っているデータの最大値、最小値を求めるサブルーチンmaxminの作り方を教えてください。(n:データ数)

subroutine maxof(x,n,xmax,xmin)
implicit real*8(a-h,o-z)
real*8
C 最大値は変数xmaxに、最小値は変数xminに代入する
 !!この部分が分かりません!!
return
end

教えてください。
よろしくお願いします。

Aベストアンサー

!検証の都合上求められているサブルーチン以外の部分のプログラムも全て書いてます。
!個人的な信条の関係で質問文のソースコード自体を意図的に無視しているところもあります。
!(問題がmaxminを定義することなのにmaxofサブルーチンを定義するようなソースになっている地点で矛盾している)

!ヒストグラムはやらない

program test

!暗黙の型宣言など邪道だ(笑)
!こうして書いてみると
!構文が非常にVBA/VB6に似ていて,派生元派生先であることを強く実感する。

implicit none
integer::n
real*8::x
real*8::y

real*8,allocatable,dimension(:)::arr

allocate(arr(5))

arr(1) = 57d0
arr(2) = 24d0
arr(3) = 38d0
arr(4) = 92d0
arr(5) = 37d0

n = ubound(arr,1)

call maxmin(arr,n,x,y)
print *,x,y

contains
!fortranは参照渡しらしい。
!個人的には二つのことを同時にやるんじゃなくて,
!max関数とmin関数だけを定義したい。
subroutine maxmin(x,n,xmax,xmin) !
real*8,dimension(:)::x
real*8::xmax
real*8::xmin

integer::n
integer::i

xmin = x(1)
xmax = x(1)

do i = 2,n
if (xmax < x(i)) then
xmax = x(i)
end if
if (xmin > x(i)) then
xmin = x(i)
end if
end do
end subroutine

end program

!検証の都合上求められているサブルーチン以外の部分のプログラムも全て書いてます。
!個人的な信条の関係で質問文のソースコード自体を意図的に無視しているところもあります。
!(問題がmaxminを定義することなのにmaxofサブルーチンを定義するようなソースになっている地点で矛盾している)

!ヒストグラムはやらない

program test

!暗黙の型宣言など邪道だ(笑)
!こうして書いてみると
!構文が非常にVBA/VB6に似ていて,派生元派生先であることを強く実感する。

implicit none
integer::n
real*...続きを読む

QVBA、最小値を取得し乱数を発生し最小値と比較する

17人の生徒がいる教室で、ランダムに生徒を当てて、当たった回数を記録し、平等に当てるというVBAを教えてください。

Aベストアンサー

こんばんは。

>17人の生徒がいる教室で、ランダムに生徒を当てて、当たった回数を記録し、平等に当てる
初心者で、VBAは習ったばかりでは、これが出来るのは、10人に1人がいいところではないでしょうか?
>当方VBAの勉強を始めたばかりでして、超初心者にわかりやすく説明していただけると非常に助かります。
勉強し始めたばかりで、いきなり、このようなものに手を出すのは、無理だと思います。
なるべく簡単なコードを書いてみましたが、私は、説明するのは苦手です。関数もいくつも入っていますから、なんとなくわかるかと思います。

丸々コードを出して云々という声もないわけではないのですが、こちらもあくまでも、人のためではなく、自分のための練習です。まあ、別の掲示板の何人かは、こちらが稼働チェック済みのコードを掲示しても、動かない、エラーが出ると言って、そのまま没にしてしまうくらいの人もいるのですから、これが分かれば、それで十分だと思います。これを参考にしようがしまいが、それは自由です。ただ、初心者であろうが、そうでなかろうが、マクロの数をこなすしか、上達の道はありません。数をこなしていくなかで、覚えていくもので、理屈では、覚えるものではありません。


'//
Sub RandomAverage()
 Dim i As Long
 Dim num As Long
 Dim num2 As Long
 '初期設定
 If Range("D18").Value = "" Then
  For i = 1 To 17
   Cells(i, 1).Value = i
  Next i
  Range("D18").Formula = "=COUNT(R[-17]C:R[-1]C)"
  Range("D19").Formula = "=SUM(R[-18]C:R[-2]C)/ROWS(R[-18]C:R[-2]C)"
 End If
 
 '17番目まで全部当てたら、更新する
 num = WorksheetFunction.CountA(Range("D1:D17"))
 num2 = WorksheetFunction.Count(Range("D1:D17"))
 If Range("D18").Value Mod 17 = 0 And num2 - num = 0 Then
  If Range("E1").Value <> "" Then
   MsgBox "全部当て終わりましたので、データを移します。"
  End If
  
  For i = 1 To 17
   Cells(i, 5).Value = Cells(i, 5).Value + Cells(i, 4).Value
   Cells(i, 4).ClearContents
   num = 0
  Next i
  
  Randomize
  For i = 1 To 17
   Cells(i, 2).Value = Rnd()
   Cells(i, 3).Formula = "=RANK(RC[-1],R1C2:R17C2,1)"
  Next i
 End If
 '次の番に'N'をつける
 For i = 1 To 17
  If Cells(i, 4).Value = "N" Then
   Cells(i, 4).Value = 1
  End If
  If Cells(i, 3).Value = num + 1 Then
   Cells(i, 4).Value = "N"
  End If
 Next i
 If num2 < 16 Then
  MsgBox "Nが、次の人です。" & vbCrLf & _
  "D19の値が正数になるように目指しましょう!"
 ElseIf num = 17 Then
  MsgBox "次は、更新します。"
 End If
End Sub
'///

こんばんは。

>17人の生徒がいる教室で、ランダムに生徒を当てて、当たった回数を記録し、平等に当てる
初心者で、VBAは習ったばかりでは、これが出来るのは、10人に1人がいいところではないでしょうか?
>当方VBAの勉強を始めたばかりでして、超初心者にわかりやすく説明していただけると非常に助かります。
勉強し始めたばかりで、いきなり、このようなものに手を出すのは、無理だと思います。
なるべく簡単なコードを書いてみましたが、私は、説明するのは苦手です。関数もいくつも入っていますから、なんとな...続きを読む

Q「 '&lng='」の&の意味が分かりません。

下記はgooglemapで中心点(lat:緯度 lng:経度)からのある半径(radius)以内のマーカーを求めるプログラムの一部ですが「 '&lng='  '&radius='」に出てくる「&」の意味・機能がわかりません。
どなたかお分かりになれば教えていただきたく。

var radius = document.getElementById('radiusSelect').value;
var searchUrl = 'phpsqlsearch_genxml.php?lat=' + center.lat() + '&lng=' + center.lng() + '&radius=' + radius;

Aベストアンサー

URLパラメータの区切りです。

phpsqlsearch_genxml.php?lat=●●&lng=▲▲&radius=★★


■IT用語辞典 e-Words
クエリ文字列 【 query string 】 クエリストリング / URLパラメータ / URL parameter

http://e-words.jp/w/E382AFE382A8E383AAE69687E5AD97E58897.html

Q配列Xの平均値を求める関数副プログラムaver(x,n)の作り方

配列xに入っているデータの平均値を求める関数副プログラムaver(x,n)の作り方がよく分かりません。

function aver(x,n)
implicit real*8(a-h,o-z)
real*8 x(*)
!!この部分が分かりません。!!
return
end

教えてください。
よろしくお願いします。

Aベストアンサー

program test
implicit none
integer::n

real*8,allocatable,dimension(:)::arr

!面倒なので直接ソース中に埋め込んでいるが,
!本来は別ファイルから読み込み,値の個数に応じて,
!allocateしなおすような仕組みを作るべき。

allocate(arr(5))

arr(1) = 57d0
arr(2) = 24d0
arr(3) = 38d0
arr(4) = 92d0
arr(5) = 37d0

!本当は引数渡しではなく,引数のみを関数に渡し,
!関数がuboundを行うべきだろうと思う。

n = ubound(arr,1)
print *,aver(arr,n)

contains
real*8 function aver(x,n)
real*8,dimension(:)::x
integer::n
integer::i
do i = 1,n
aver = aver + x(i)
end do
aver = aver / n
end function
end program

program test
implicit none
integer::n

real*8,allocatable,dimension(:)::arr

!面倒なので直接ソース中に埋め込んでいるが,
!本来は別ファイルから読み込み,値の個数に応じて,
!allocateしなおすような仕組みを作るべき。

allocate(arr(5))

arr(1) = 57d0
arr(2) = 24d0
arr(3) = 38d0
arr(4) = 92d0
arr(5) = 37d0

!本当は引数渡しではなく,引数のみを関数に渡し,
!関数がuboundを行うべきだろうと思う。

n = ubound(arr,1)
print *,aver(arr,n)

contains
real*8 functi...続きを読む

QNext,End Withのエラー

Sub 入力()
If Sheets("入力").Range("D3").Value = "" Then
MsgBox "客先名を入力して下さい"
Else
Dim K最終行 As Long
Dim T最終行 As Long
Dim i As Integer
With Sheets("入力")
For i = 3 To 12
If .Cells(i, "H").Value <> "" Then
U最終行 = Sheets("注文書").Range("G65536").End(xlUp).Row + 1
If U最終行 = 461 Then
MsgBox "注文書がいっぱいです"
Exit Sub
Else
End If
E最終行 = Sheets("営業確認").Range("G65536").End(xlUp).Row + 1
Sheets("営業確認").Range("k" & E最終行).Value = .Cells(i, "b").Value
Sheets("営業確認").Range("b" & E最終行).Value = .Cells(i, "c").Value
Sheets("営業確認").Range("c" & E最終行).Value = .Cells(i, "d").Value
Sheets("営業確認").Range("d" & E最終行).Value = .Cells(i, "e").Value
Sheets("営業確認").Range("g" & E最終行).Value = .Cells(i, "h").Value
Sheets("営業確認").Range("f" & E最終行).Value = .Cells(i, "i").Value
Sheets("営業確認").Range("i" & E最終行).Value = .Cells(i, "m").Value
Sheets("営業確認").Range("h" & E最終行).Value = .Cells(i, "p").Value
Else
End If
Select Case .Cells(i, "o").Value
Case "北"
K最終行 = Sheets("北").Range("h65536").End(xlUp).Row + 1
Sheets("北").Range("B" & K最終行).Value = .Cells(3, "C").Value
Sheets("北").Range("c" & K最終行).Value = .Cells(3, "b").Value
Case "中"
T最終行 = Sheets("中").Range("H65536").End(xlUp).Row + 1
Sheets("中").Range("b" & T最終行).Value = .Cells(3, "c").Value
Sheets("中").Range("c" & T最終行).Value = .Cells(3, "b").Value
End Select

Exit Sub

Dim Dummy As Worksheet
Dim SheetName As String

Dim OTA As Long
Dim GEN As Long
Dim SheetName2 As String

With Sheets("入力")

'3行目~22行目まで
For j = 3 To 22

SheetName = Sheets("入力").Range("D3").Value


On Error Resume Next
Set Dummy = Sheets(SheetName)
SheetName2 = .Cells(i, 14).Value
'もしシートがあれば・・・
If Err.Number = 0 Then

'SheetName2は入力シートのN行
SheetName2 = .Cells(i, 14).Value

OTA = Sheets(SheetName2).Range("B65536").End(xlUp).Row + 1

Sheets(SheetName2).Range("A7").Value = .Cells(3, "D").Value
Sheets(SheetName2).Range("C3").Value = .Cells(3, "C").Value
Sheets(SheetName2).Range("B" & OTA).Value = .Cells(i, "H").Value
Sheets(SheetName2).Range("I" & OTA).Value = .Cells(i, "I").Value
Sheets(SheetName2).Range("F" & OTA).Value = .Cells(i, "K").Value
Sheets(SheetName2).Range("H" & OTA).Value = .Cells(i, "L").Value
Sheets(SheetName2).Range("J" & OTA).Value = .Cells(i, "M").Value


'シートが無ければ・・・
Else

GEN = Sheets("原紙").Range("B65536").End(xlUp).Row + 1
Sheets("原紙").Range("A7").Value = .Cells(3, "D").Value
Sheets("原紙").Range("C3").Value = .Cells(3, "C").Value
Sheets("原紙").Range("B" & GEN).Value = .Cells(i, "H").Value
Sheets("原紙").Range("I" & GEN).Value = .Cells(i, "I").Value
Sheets("原紙").Range("F" & GEN).Value = .Cells(i, "K").Value
Sheets("原紙").Range("H" & GEN).Value = .Cells(i, "L").Value
Sheets("原紙").Range("J" & GEN).Value = .Cells(i, "M").Value

'原紙をコピーする
Sheets("原紙").Copy BEFORE:=Sheets(1)
'シートの名前を市場コードにする
Sheets(1).Name = SheetName

Next
End With

Exit Sub

On Error GoTo 0

Sheets("原紙").Select

Range("C3:E3,A7,B16:B35,F16:F35,H16:J35").Select
Range("H35").Activate
Selection.ClearContents

Sheets("入力").Select

Sheets("入力").Range("D3,G3:J12,L3:M12").Value = ""
Sheets("入力").Range("D3").Select
Range("B3").Formula = "=IF(D3="""","""",VLOOKUP(D3,'\\Seika-sv01\支店共有\マーケティング用\[担当者リスト.xls]リスト形式'!$B:$D,3,FALSE))"
MsgBox "入力が完了しました"
End If
End Sub

上記のようにマクロを組みましたがエラーが出てしまいます。

Sub 入力()
If Sheets("入力").Range("D3").Value = "" Then
MsgBox "客先名を入力して下さい"
Else
Dim K最終行 As Long
Dim T最終行 As Long
Dim i As Integer
With Sheets("入力")
For i = 3 To 12
If .Cells(i, "H").Value <> "" Then
U最終行 = Sheets("注文書").Range("G65536").End(xlUp).Row + 1
If U最終行 = 461 Then
MsgBox "注文書がいっぱいです"
Exit Sub
Else
End If
E最終行 = Sheets("営業確認").Range("G65536").End(xlUp).Row + 1
Sheets("営業確認").Range("k...続きを読む

Aベストアンサー

WithとEnd With
ForとNext
IfとEnd If
これらの対応をもう一度見直してください。


このカテゴリの人気Q&Aランキング

おすすめ情報