PROGRAM lesson13
! This program is for lesson13
! 型宣言
implicit none
real,dimension(100) :: x,y ! 測定データ
real k,c ! スタジア定数　乗定数（傾き）:k，加定数（切片）:c
real R ! 相関係数 R
integer N ! 入力データ数
integer I! 制御変数
character*20:: infile,outfile ! 入出力ファイル名
write(*,*)''
write(*,'(A)')' ** 線形最小二乗法によるスタジア定数の算定 ** '
! 入力データの情報の読込（キーボード）
write(*,*) '入力ファイル名は？'
read(*,'(A)') infile
write(*,*) '入力データ数は？'
read(*,*) N
! 入力データの読込（ファイル）
open(1,file=infile)
read(1,*) (X(I),Y(I),I=1,N)
! 最小二乗法
call keisan(k,c,N,X,Y)
! 相関係数
call sokan(N,X,Y,R)
! 結果の表示（画面）
write(*,*) ' '
write(*,'(A)') 'スタジア定数'
write(*,'(A,F8.3)')' 乗定数 k= ', k
write(*,'(A,F8.3)')' 加定数 c= ', c
write(*,'(A,F8.3,A,F8.3)')' 回帰直線 L=', k ,' x+',c
write(*,'(A,F8.5)')' 相関係数 R=', R
! 出力データの情報の読込（キーボード）
write(*,*) ' '
write(*,*) '結果出力ファイル名は？'
read(*,'(A)') outfile
! 結果の書込（ファイル）
open(2,file=outfile)
write(2,'(A)')' ** 線形最小二乗法によるスタジア定数の算定 ** '
write(2,'(A,I4)') '入力データ数= ',n
write(2,*) ' '
write(2,*) ' X
Y '
write(2,'(2F8.3)') (X(I),Y(I),I=1,N)
write(2,*) ' '
write(2,'(A)') 'スタジア定数'
write(2,'(A,F8.3)')' 乗定数 k= ', k
write(2,'(A,F8.3)')' 加定数 c= ', c
write(2,'(A,F8.3,A,F8.3)')' 回帰直線 L=', k ,' x+',c
write(2,*) ' '
write(2,'(A,F8.5)')' 相関係数 R=', R
stop
end program lesson13
subroutine keisan(AA,BB,NDATA,X,Y)
implicit none
integer NDATA ! 入力データ数
integer I! 制御変数
real,dimension(100) :: x,y ! 測定データ
real AA,BB ! 直線回帰式　傾き:AA，切片:BB
real SUMX,SUMY,SUMXY,SUMX2,DET
! 初期値設定
SUMX=0.
SUMY=0.
SUMXY=0.
SUMX2=0.
! 各種パラメータの計算
do I=1,NDATA
SUMX=SUMX+X(I)
SUMY=SUMY+Y(I)
SUMX2=SUMX2+X(I)*X(I)
SUMXY=SUMXY+X(I)*Y(I)
end do
DET=NDATA*SUMX2-SUMX*SUMX
AA=(NDATA*SUMXY-SUMX*SUMY)/DET
BB=(SUMX2*SUMY-SUMX*SUMXY)/DET
end subroutine keisan
subroutine sokan(NDATA,X,Y,R)
implicit none
integer NDATA ! 入力データ数
integer I! 制御変数
real,dimension(100) :: x,y ! 測定データ
real R ! 相関係数 R
real AVEX,AVEY
real SUMX,SUMY,SUMXY,SUMXX,SUMYY
! 初期値設定
SUMX=0.
SUMY=0.
SUMXY=0.
SUMXX=0.
SUMYY=0.
! 各種パラメータの計算
do I=1,NDATA
SUMX=SUMX +X(I)
SUMY=SUMY +Y(I)
end do
AVEX=SUMX/NDATA
AVEY=SUMY/NDATA
do I=1,NDATA
SUMXY=SUMXY+(AVEX-X(I))*(AVEY-Y(I))
SUMXX=SUMXX+(AVEX-X(I))**2
SUMYY=SUMYY+(AVEY-Y(I))**2
end do
R=SUMXY/(sqrt(SUMXX)*sqrt(SUMYY))
end subroutine sokan

トランシット・セオドライト

jsc result

LESSON13 練習譜例