01-1program.for.txt
c ********************************************************
c 第1回ゼミc
三角化法による連立方程式の解法
c
三角化法(LU分解法・非対称行列)による逆行列の計算
cc 作成者 伊賀 久晃
作成日 2004.5.2
c ********************************************************cdimension a(10,10),s(10,10),ia(10,10),b(10,1),y(10,1),x(10,1)
dimension l(10,10),u(10,10),il(10,10),iu(10,10),d(10,10)
real a,l,u,s,il,iu,ia,b,y,x,d
integer i,j,nopen(1,file='input01.txt',status='old')open(2,file='input02.txt',status='old')cread(1,'(2x,i8)') n
write(*,*) 'A行列'
do 1 i=1,nread(1,'(10f8.4)') (a(i,j),j=1,n)read(2,'(f8.4)') b(i,1)
write(*,'(10f8.4)') (a(i,j),j=1,n)
1 continue
call crout(l,u,a,n)call seki(s,l,u,n)call invl(il,l,n)call invu(iu,u,n)write(*,*) '(問1) A行列のLU分解後のL行列
do 2 i=1,nwrite(*,'(10f8.4)') (l(i,j),j=1,n)
2 continue'

write(*,*) 'A行列のLU分解後のU行列'
do 3 i=1,nwrite(*,'(10f8.4)') (u(i,j),j=1,n)
3 continue
write(*,*) 'L行列とU行列の積S行列 (検証)'do 4 i=1,nwrite(*,'(10f8.4)') (s(i,j),j=1,n)4 continue
write(*,*) '(問2) L行列の逆行列IL行列
do 5 i=1,nwrite(*,'(10f8.4)') (il(i,j),j=1,n)
5 continue
call seki(s,l,il,n)'write(*,*) 'L行列とL行列の逆行列IL行列の積S行列 (検証)'do 6 i=1,nwrite(*,'(10f8.4)') (s(i,j),j=1,n)
ページ(1)

01-1program.for.txt
6 continue
write(*,*) 'U行列の逆行列IU行列'
do 7 i=1,nwrite(*,'(10f8.4)') (iu(i,j),j=1,n)
7 continue
call seki(s,u,iu,n)write(*,*) 'U行列とU行列の逆行列IU行列の積S行列 (検証)'do 8 i=1,nwrite(*,'(10f8.4)') (s(i,j),j=1,n)8 continue
call seki(ia,iu,il,n)write(*,*) '(問3) A行列の逆行列IA行列をIU行列とIL行列より算出'
do 9 i=1,nwrite(*,'(10f8.4)') (ia(i,j),j=1,n)9 continue
call seki(y,il,b,n)write(*,*) '(問4) IL行列とBベクトルよりYベクトルを算出'
do 900 i=1,nwrite(*,'(10f8.4)') y(i,1)
900 continue
call seki(x,iu,y,n)write(*,*) 'IU行列とYベクトルよりXベクトルを算出'
do 910 i=1,nwrite(*,'(10f8.4)') x(i,1)
910 continue
call inverse(n,a,d)write(*,*) '(問5) クラウト法による逆行列を求める&サブルーチンを用いた結果'
do 920 i=1,nwrite(*,'(10f8.4)') (d(i,j),j=1,n)920 continue
call seki(s,ia,b,n)write(*,*) '(問6) BベクトルにIA行列を乗じてXベクトルを算出
do 930 i=1,nwrite(*,'(10f8.4)') s(i,1)
930 continue
stop
end
c
c---------------------------------------------subroutine crout(l,u,a,n)c
クラウト法を用いLU分解するサブルーチン
dimension a(10,10),l(10,10),u(10,10),d(10,10)
real
a,l,u,dinteger i,j,k,n
ページ(2)'

01-1program.for.txt

cdo 10 i=1,ndo 10 j=1,nd(i,j)=a(i,j)
if(i.le.j) thendo 11 k=1,i-1
d(i,j)=d(i,j)-d(i,k)*d(k,j)
11continueif(i.lt.j) d(i,j)=d(i,j)/d(i,i)
else
do 12 k=1,j-1
d(i,j)=d(i,j)-d(i,k)*d(k,j)
12continueend if10 continue
L行列とU行列に要素を分ける
do 13 i=1,ndo 13 j=1,nif(i.ge.j) thenl(i,j)=d(i,j)
if(i.eq.j) thenu(i,j)=1.00
else
u(i,j)=0.00
end ifelse
u(i,j)=d(i,j)
l(i,j)=0.00
end if13 continue
returnendcc---------------------------------------------subroutine seki(s,l,u,n)c 行列の乗算を行うサブルーチン
dimension s(10,10),l(10,10),u(10,10)
real
s,l,u
integer i,j,k,n
do 20 i=1,ndo 20 j=1,ns(i,j)=0.0
do 20 k=1,ns(i,j)=s(i,j)+l(i,k)*u(k,j)
20 continue
returnendcc---------------------------------------------subroutine invl(il,l,n)c 下三角の逆行列を求めるサブルーチン
dimension il(10,10),l(10,10)
real
il,l
integer i,j,k,n
ページ(3)

01-1program.for.txt
do 30 i=1,ndo 30 j=1,nif(i.eq.j) il(i,j)=1.0/l(i,j)
if(i.lt.j) il(i,j)=0.0
if(i.gt.j) thenil(i,j)=0.0
do 31 k=1,i-1
il(i,j)=il(i,j)+l(i,k)*il(k,j)
31
continueil(i,j)=-il(i,j)/l(i,i)
end if30 continue
returnendcc---------------------------------------------subroutine invu(iu,u,n)c 上三角の逆行列を求めるサブルーチン
dimension iu(10,10),u(10,10)
real
iu,u
integer i,j,k,n
do 40 i=1,ndo 40 j=1,nif(i.eq.j) iu(i,j)=1.0
if(i.gt.j) iu(i,j)=0.0
if(i.lt.j) theniu(i,j)=0.0
do 41 k=i,j-1
iu(i,j)=iu(i,j)-iu(i,k)*u(k,j)
41
continueend if40 continue
returnendcc---------------------------------------------subroutine inverse(n,a,d)c クラウト法による逆行列を求めるサブルーチンca:入力行列cd:行列aの逆行列
dimension a(10,10),b(10),c(10),d(10,10)151

do 154 i=1,ndo 151 j=1,nb(j)=a(j,i)
a(j,i)=0.0a(i,i)=1.0

152

do 152 j=1,nc(j)=a(i,j)/b(i)153

do 153 j=1,ndo 153 k=1,na(j,k)=a(j,k)-c(k)*b(j)ページ(4)

01-1program.for.txt
154

do 154 j=1,na(i,j)=c(j)156

do 156 i=1,ndo 156 j=1,nd(i,j)=a(i,j)
returnend

ページ(5)

input01.txt
4
1.0000 1.0000 0.0000 3.0000
2.0000 1.0000 -1.0000 1.0000
3.0000 -1.0000 -1.0000 2.0000-1.0000 2.0000 3.0000 -1.0000

ページ(1)

input02.txt
4.00001.0000-3.0000
4.0000

ページ(1)

01-2program.for.txt
c ********************************************************
c 第1回ゼミc
三角化法による連立方程式の解法
c
三角化法(コレスキー分解法・対称行列)による逆行列の計算
cc 作成者 東海林 勉
作成日 2004.5.10
c ********************************************************creal a(10,10),b(10),t(10,10),s(10,10),&a1(10,10),b1(10),aa(10,10),tt(10,10),&ss(10,10),y(10),x(10),d(10,10)copen(5,file='input2.dat',status='old')read(5,*) ncc**** 三角行列要素ゼロ設定*******************
cdo 120 i=1,ndo 120 j=1,nt(i,j)=0.0
ss(i,j)=0.0
120 continuecc***** データの読み込み*********************
cwrite(6,*) 'A 行列'
do 1 i=1,nread(5,*) (a(i,j),j=1,n)write(6,'(10f8.4)') (a(i,j),j=1,n)
1 continuecwrite(6,*) 'B ベクトル'
read(5,*) (b(i),i=1,n)do 2 i=1,nwrite(6,'(10f8.4)') b(i)2 continuecc***** (1) 下三角行列Λの計算*******************ct:下三角行列Λcdo 3 j=1,n-1t(j,j)=a(j,j)
t(j,j)=sqrt(t(j,j))al=1.0/t(j,j)
do 3 k=n,j+1,-1t(k,j)=al*a(k,j)
t1=t(k,j)
do 3 i=k,na(i,k)=a(i,k)-t(i,j)*t1
3 continuet(n,n)=a(n,n)
t(n,n)=sqrt(t(n,n))cwrite(6,*) '(1) 下三角行列 Λ'
do 4 i=1,nwrite(6,'(10f8.4)') (t(i,j),j=1,n)4 continuec
ページ(1)

01-2program.for.txt
c***** 上三角行列ΛTの計算 （Λの転置）*****cs:上三角行列 ΛTcdo 10 i=1,ndo 10 j=1,ns(i,j)=t(j,i)
10 continue
write(6,*) ' 上三角行列ΛT'
do 15 i=1,nwrite(6,'(10f8.4)') (s(i,j),j=1,n)
15 continuecc***** (2) チェック {Λ*ΛT=A} ****************
cdo 20 i=1,ndo 20 j=1,na2=0.0do 21 k=1,na2=t(i,k)*s(k,j)+a2
21
continuea1(i,j)=a2
20 continuecwrite(6,*) '(2) チェック A行列'
do 25 i=1,nwrite(6,'(10f8.4)') (a1(i,j),j=1,n)
25 continuecc***** (3) 上三角逆行列計算 ΛT^(－1) ***css：上三角逆行列 ΛT^(－1)
css(1,1)=1.0/s(1,1)
do 30 j=2,nss(j,j)=1.0/s(j,j)
m=j-1
do 30 k=1,mss1=0.0
do 31 i=k,mss1=ss1-ss(k,i)*s(i,j)
31
continuess(k,j)=ss1*ss(j,j)
30 continuecwrite(6,*) '(3) 上三角逆行列 ΛT^(－1)'
do 35 i=1,nwrite(6,'(10f8.4)') (ss(i,j),j=1,n)
35 continuecc**** 下三角逆行列計算 Λ^(－1)*************
ctt：下三角逆行列 Λ^(－1)
cdo 40 i=1,ndo 40 j=1,ntt(i,j)=ss(j,i)
40 continuecwrite(6,*) ' 下三角逆行列 Λ^(-1)'
do 45 i=1,n
ページ(2)

01-2program.for.txt
write(6,'(10f8.4)') (tt(i,j),j=1,n)
45 continuecc***** (4) Aの逆行列の計算 *****************caa:Aの逆行列 A^-1cdo 60 i=1,n
do 60 j=1,naa1=0.0
do 61 k=1,naa1=ss(i,k)*tt(k,j)+aa1
61
continueaa(i,j)=aa1
60 continuecwrite(6,*) '(4) A逆行列 A^(-1)'
do 65 i=1,nwrite(6,'(10f8.4)') (aa(i,j),j=1,n)
65 continuecc**** (5) ベクトルYの計算 *************************
ccdo 80 i=1,ny1=0.0do 81 k=1,iy1=tt(i,k)*b(k)+y1
81
continuey(i)=y1
80 continuecwrite(6,*) '(5) ベクトルY'
do 85 i=1,nwrite(6,'(10f8.4)') y(i)85 continuecc***** ベクトルXの値 ***********************
cdo 90 i=1,nx1=0.0do 91 k=i,nx1=ss(i,k)*y(k)+x1
91
continuex(i)=x1
90 continuecwrite(6,*) ' ベクトルX'
do 95 i=1,nwrite(6,'(10f8.4)') x(i)95 continuecc***** (6) チェック AX＝B *****************
cdo 100 i=1,nb2=0.0do 101 k=1,nb2=a1(i,k)*x(k)+b2
101
continue
ページ(3)

01-2program.for.txt
b1(i)=b2
100 continuecwrite(6,*) '(6) チェック B'
do 105 i=1,nwrite(6,'(10f8.4)') b1(i)105 continuecc***** (7) 一般的な方法で求めた結果 *****************ccall inverse(n,a,d)write(6,*) '(7) 一般的な方法で求めた結果'
do 110 i=1,nwrite(6,'(10f8.4)') (d(i,j),j=1,n)
110 continuecc***** (8) ベクトルXをX=A^(-1)Bより算出*************
cdo 130 i=1,ndo 130 j=1,ns(i,j)=0.0
do 130 k=1,ns(i,j)=s(i,j)+d(i,k)*b(k)130 continue
write(6,*) '(8) ベクトルX'
do 140 i=1,nwrite(6,'(10f8.4)') s(i,1)
140 continue
stopendc---------------------------------------------subroutine inverse(n,a,d)c
一般的な逆行列を求めるサブルーチンca:入力行列cd:行列aの逆行列
dimension a(10,10),b(10),c(10),d(10,10)151

do 154 i=1,ndo 151 j=1,nb(j)=a(j,i)
a(j,i)=0.0a(i,i)=1.0

152

do 152 j=1,nc(j)=a(i,j)/b(i)153

do 153 j=1,ndo 153 k=1,na(j,k)=a(j,k)-c(k)*b(j)154

do 154 j=1,na(i,j)=c(j)ページ(4)

01-2program.for.txt
156

do 156 i=1,ndo 156 j=1,nd(i,j)=a(i,j)
returnend

ページ(5)

input2.txt
5
9
-6
6
0
0
7
5
4
6
8

-6
5
0
1
0

6
0
29
4
-9

0
1
4
5
-2

0
0
-9
-2
26

ページ(1)

01-3program.for.txt
c ********************************************************
c 第1回ゼミc
三角化法による連立方程式の解法
c
三角化法(変形コレスキー分解)による逆行列の計算
cc 作成者 東海林 勉
作成日 2004.5.17
c ********************************************************creal a(10,10),b(10,10),t(10,10),tt,d(10,10),dl(10,10),&u(10,10),r(10,10),dd(10,10),s(10,10),&rr(10,10),dy(10,10),dinv(10,10),y(10,10),&uinv(10,10),x(10,10),bchk(10,10)copen(1,file='input3.dat',status='old')read(1,*) ncc**** 三角行列要素ゼロ設定*******************
cdo 120 i=1,ndo 120 j=1,nt(i,j)=0.0
120 continuecc***** データの読み込み*********************
cwrite(6,*) 'A 行列'
do 1 i=1,nread(1,*) (a(i,j),j=1,n)write(6,'(10f8.4)') (a(i,j),j=1,n)
1 continuecwrite(6,*) 'B ベクトル'do 2 i=1,nread(1,*) b(i,1)
write(6,'(10f8.4)') b(i,1)
2 continuecc**** A=LDU ************************
cdo 10 i=1,ndo 10 j=1,nif(i.ge.j) thenif(i.eq.j) thenif(i.eq.1.and.j.eq.1) thent(i,j)=a(i,j)
else
tt1=0.0
do 11 k=1,i-1
tt=t(i,k)**2.0*t(k,k)
tt1=tt+tt1
11continuet(i,j)=a(i,j)-tt1
end ifelse
if(j.eq.1) thent(i,j)=a(i,j)/t(1,1)
else
tt1=0.0
ページ(1)

01-3program.for.txt
do 12 k=1,i-1
tt=t(i,k)*t(j,k)*t(k,k)
tt1=tt+tt1
12continuet(i,j)=(a(i,j)-tt1)/t(j,j)
end ifend ifend if10 continuecc**** L・D・U の計算 *****************
cdo 50 i=1,n
do 50 j=1,nif(i.eq.j) thend(i,j)=t(i,j)
else
dl(i,i)=1.0
dl(i,j)=t(i,j)
end if50 continueccall tench(n,dl,u)cwrite(6,*) '▽(1)-----------------'
write(6,*) 'L'
do 60 i=1,nwrite(6,'(10f8.4)') (dl(i,j),j=1,n)60 continuecwrite(6,*) 'D'
do 55 i=1,nwrite(6,'(10f8.4)') (d(i,j),j=1,n)
55 continuecwrite(6,*) 'U'
do 110 i=1,nwrite(6,'(10f8.4)') (u(i,j),j=1,n)
110 continuecc**** D^(1/2) ************************
c dd:D^(1/2)
write(6,*) 'D^1/2'
do 111 i=1,ndo 111 j=1,ndd(i,j)=sqrt(d(i,j))
111 continuecc **** Λ=LD^(1/2) ********************
call matrix(n,dl,dd,r)write(6,*) '▽(2)-----------------'
write(6,*) 'Λ=LD^(1/2)'
do 100 i=1,nwrite(6,'(10f8.4)') (r(i,j),j=1,n)
100 continuecc **** ΛT=D^(1/2)L^T' ****************
call matrix(n,dd,u,rr)
ページ(2)

01-3program.for.txt
write(6,*) 'Λ^T=D^(1/2)L^T'
do 122 i=1,nwrite(6,'(10f8.4)') (rr(i,j),j=1,n)
122 continuec****L^-1 ***************************
call inverse(n,dl,s)
c**** Y' ******************************
call matrix(n,s,b,dy)
write(6,*) '▽(3)-----------------'
write(6,*) 'Y´'
do 135 i=1,nwrite(6,'(10f8.4)') (dy(i,j),j=1,n)
135 continue
c**** D^-1 **********************************
call inverse(n,d,dinv)
c**** Y *************************************
call matrix(n,dinv,dy,y)write(6,*) 'Y'
do 137 i=1,nwrite(6,'(10f8.4)') y(i,1)
137 continue
c**** U^-1 **********************************
call tench(n,s,uinv)
c**** X *************************************
call matrix(n,uinv,y,x)
write(6,*) 'X'
do 139 i=1,nwrite(6,'(10f8.4)') x(i,1)
139 continuecc**** チェック AX=B *************************
call matrix(n,a,x,bchk)
write(6,*) '▽(4)-----------------'
write(6,*) 'B'
do 140 i=1,nwrite(6,'(10f8.4)') bchk(i,1)
140 continue
stopend
c**************************************c
転置c**************************************
subroutine tench(n,bm,am)
real am(10,10),bm(10,10)
do 70 i=1,n
do 70 j=1,nam(i,j)=bm(j,i)
70 continue
returnendcc*************************************
c
行列の乗算
c*************************************
subroutine matrix(n,aa,bb,ab)
real aa(10,10),bb(10,10),ab(10,10)
ページ(3)

01-3program.for.txt
do 15 i=1,ndo 15 j=1,nsum=0.0
do 16 k=1,nsum=aa(i,k)*bb(k,j)+sum
16 continueab(i,j)=sum
15 continue
returnendcc**************************************c
逆行列の算定c**************************************
subroutine inverse(n,cc,s)real cc(10,10),s(10,10)
do 150 i=1,ndo 150 j=1,nif(i.eq.j) thens(i,j)=1.0/cc(i,j)
else
sum1=0.0
do 151 k=j,i-1
sum1=sum1+cc(i,k)*s(k,j)
151 continues(i,j)=-(sum1/cc(i,i))
end if
150 continue
returnendc

ページ(4)

input3.txt
5
9
-6
6
0
0
7
5
4
6
8

-6
5
0
1
0

6
0
29
4
-9

0
1
4
5
-2

0
0
-9
-2
26

ページ(1)

02-1program.for.txt
c ********************************************************
c 第2回ゼミc
非線形方程式の数値解析法
c
1階ニュートン法
cc 作成者 東海林 勉
作成日 2004.5.17
c ********************************************************
c 一次微係数利用cc f(x)=x**3+3*x**2-5=0creal x,f(10),df(10),dx(10)integer n
eps=0.0001
x=1.0
n=10
write(6,'(''
x
dx
df(x)
f(x)'')')
cdo k=1,nf(k)=(x**3)+(3*x**2)-5
df(k)=3*x**2+6*x
dx(k)=-f(k)/df(k)write(6,'(4f9.5)') x,dx(k),df(k),f(k)if(abs(f(k)).lt.eps) go to 111
x=x+dx(k)end doc
111 write(6,*) k,'回'
stop
end

ページ(1)

02-2program.for.txt
c ********************************************************
c 第2回ゼミc
非線形方程式の数値解析法
c
ベイリー法
c
c 作成者 東海林 勉
作成日 2004.5.17
c ********************************************************
c 二次微係数利用cc f(x)=x**3+3*x**2-5=0creal x1,f(10),df(10),ddf(10),dff(10)real aa,bb
integer n
eps=0.0001
x1=1.0n=10
write(6,'('' xdxdfddf(x)
f(x)'')')
cdo k=1,nf(k)=(x1**3.0)+(3.0*x1**2.0)-5.0
df(k)=3.0*x1**2.0+6.0*x1
ddf(k)=6.0*x1+6.0
aa=(df(k)**2-2*ddf(k)*f(k))**0.5
bb=1/ddf(k)dff(k)=(-df(k)+aa)*bb
write(6,'(6f9.5)') x1,dff(k),df(k),ddf(k),f(k)if(abs(f(k)).le.eps) go to 111
x1=x1+dff(k)end doc
111 write(6,*) k,'回'
stop
end

ページ(1)

02-3program.for.txt
c ********************************************************
c 第2回ゼミc
非線形方程式の数値解析法c
ニュートン法による連立方程式の解法(一般的逆行列法)cc 作成者 東海林 勉
作成日 2004.5.17
c ********************************************************
c 一次微係数利用cc F=x**2+y**2-4
c G=(x**2)/9+y**2-1
c-------------------------real a(10,10),dGx,dGy,ainv(10,10),ddx(10,10),&b(10,10)
c
x=1.0
y=1.0
n=2.0
eps=0.00001
write(6,*) ' x
y
dx
dy
F
G'
c
do 200 k=1,20
F=x**2+y**2-4
G=(x**2)/9+y**2-1
dGx=(2*x)/9dGy=2*ydFx=2*xdFy=2*ya(1,1)=dFxa(1,2)=dFya(2,1)=dGxa(2,2)=dGyb(1,1)=-Fb(2,1)=-Gccall inverse(n,a,ainv)
call matrix(n,ainv,b,ddx)
4 continue
dx=ddx(1,1)
dy=ddx(2,1)
write(6,'(10f8.5)') x,y,dx,dy,F,G
if(abs(F).le.eps.and.abs(G).le.eps) go to 111
x=x+dxy=y+dy200 continue
111 write(6,*) k,'回'
stopend
c**************************************c
逆行列の算定c**************************************
subroutine inverse(n,a1,d)c
a:入力行列cd:行列aの逆行列
dimension a1(10,10),b(10),c(10),d(10,10)
do 154 i=1,ndo 151 j=1,nb(j)=a1(j,i)
ページ(1)

02-3program.for.txtc151

a1(j,i)=0.0a1(i,i)=1.0
do 152 j=1,n
152 c(j)=a1(i,j)/b(i)do 153 j=1,ndo 153 k=1,n
153 a1(j,k)=a1(j,k)-c(k)*b(j)do 154 j=1,n
154 a1(i,j)=c(j)cdo 156 i=1,ndo 156 j=1,n
156 d(i,j)=a1(i,j)
returnend
c*************************************
c
行列の乗算
c*************************************
subroutine matrix(n,aa,bb,ab)
real aa(10,10),bb(10,10),ab(10,10)c
do 15 i=1,ndo 15 j=1,nsum=0.0
do 16 k=1,nsum=aa(i,k)*bb(k,j)+sum
16 continueab(i,j)=sum
15 continue
returnend

ページ(2)

02-4program.for.txt
c ********************************************************
c 第2回ゼミc
非線形方程式の数値解析法c
ニュートン法による連立方程式の解法(コレスキー分解法)cc 作成者 東海林 勉
作成日 2004.5.29
c ********************************************************
c 一次微係数利用cc F=16*x**2+5*x*y+50*y**2-74
c G=4*x**2+25*x*y**2+10*y-41c-------------------------real a(10,10),dGx,dGy,ainv(10,10),ddx(10,10),&b(10,10),u(10,10),l(10,10),iu(10,10),il(10,10)cwrite(6,*) '<Newton法>'
x=1.0
y=1.0
n=2.0
eps=0.0001
do 100 i=1,2cwrite(6,'(a5,f5.2,a5,f5.2)') 'x=',x,'y=',ywrite(6,*) ' x
y
dx
dy
F
do 200 k=1,20
F=16.*x**2.+5.*x*y+50.*y**2.-74.
G=4.*x**2.+25.*x*y**2.+10.*y-41.
dFx=32.*x+5.*ydFy=5.*x+100.*y
dGx=8.*x+25.*y**2.
dGy=50.*x*y+10.
a(1,1)=dFxa(1,2)=dFya(2,1)=dGxa(2,2)=dGyb(1,1)=-Fb(2,1)=-Gccall crout(l,u,a,n)call invu(iu,u,n)call invl(il,l,n)call matrix(n,iu,il,ainv)
call matrix(n,ainv,b,ddx)
dx=ddx(1,1)
dy=ddx(2,1)
write(6,'(10f8.5)') x,y,dx,dy,F,G
if(abs(F).le.eps.and.abs(G).le.eps) go to 111
x=x+dxy=y+dy200
continue
111
write(6,*) k,'回'
write(6,*) ' '
x=2.0
y=1.0
100 continue
ページ(1)

G'

02-4program.for.txt
stop
end
c
c---------------------------------------------subroutine crout(l,u,a,n)c
クラウト法を用いLU分解するサブルーチン
dimension a(10,10),l(10,10),u(10,10),d(10,10)
real
a,l,u,dinteger i,j,k,nc

do 10 i=1,ndo 10 j=1,nd(i,j)=a(i,j)
if(i.le.j) thendo 11 k=1,i-1
d(i,j)=d(i,j)-d(i,k)*d(k,j)
11continueif(i.lt.j) d(i,j)=d(i,j)/d(i,i)
else
do 12 k=1,j-1
d(i,j)=d(i,j)-d(i,k)*d(k,j)
12continueend if10 continue
L行列とU行列に要素を分ける
do 13 i=1,ndo 13 j=1,nif(i.ge.j) thenl(i,j)=d(i,j)
if(i.eq.j) thenu(i,j)=1.00
else
u(i,j)=0.00
end ifelse
u(i,j)=d(i,j)
l(i,j)=0.00
end if13 continue
returnendcc---------------------------------------------subroutine invl(il,l,n)c
下三角の逆行列を求めるサブルーチン
dimension il(10,10),l(10,10)
real
il,l
integer i,j,k,n
do 30 i=1,ndo 30 j=1,nif(i.eq.j) il(i,j)=1.0/l(i,j)
if(i.lt.j) il(i,j)=0.0
if(i.gt.j) thenil(i,j)=0.0
do 31 k=1,i-1
il(i,j)=il(i,j)+l(i,k)*il(k,j)
ページ(2)

02-4program.for.txt
continueil(i,j)=-il(i,j)/l(i,i)
end if30 continue
31

returnendcc---------------------------------------------subroutine invu(iu,u,n)c
上三角の逆行列を求めるサブルーチン
dimension iu(10,10),u(10,10)
real
iu,u
integer i,j,k,n
do 40 i=1,ndo 40 j=1,nif(i.eq.j) iu(i,j)=1.0
if(i.gt.j) iu(i,j)=0.0
if(i.lt.j) theniu(i,j)=0.0
do 41 k=i,j-1
iu(i,j)=iu(i,j)-iu(i,k)*u(k,j)
41
continueend if40 continue
returnendcc---------------------------------------------subroutine matrix(n,aa,bb,ab)c
行列の乗算を行うサブルーチン
real aa(10,10),bb(10,10),ab(10,10)c
do 15 i=1,ndo 15 j=1,nsum=0.0
do 16 k=1,nsum=aa(i,k)*bb(k,j)+sum
16 continueab(i,j)=sum
15 continue
returnend

ページ(3)

02-5program.for.txt
c ********************************************************
c 第2回ゼミc
非線形方程式の数値解析法
c
ベイリー法による連立方程式の解法
cc 作成者 東海林 勉
作成日 2004.5.29
c ********************************************************
c 二次微係数利用cc F=16*x**2+5*x*y+50*y**2-74
c G=4*x**2+25*x*y**2+10*y-41c-------------------------real dGx,dGy,b(10,10),a2(10,10),& a2inv(10,10),ddx2(10,10),l(10,10),u(10,10),& il(10,10),iu(10,10)cwrite(6,*) '<Bailey法>'
c
x=1.0
y=1.0
n=2.0
eps=0.0001
do 100 i=1,2
write(6,'(a5,f5.2,a5,f5.2)') 'x=',x,'y=',ywrite(6,*) ' x
y
dx
dy
F
c
do 200 k=1,20
F=16.*x**2.+5.*x*y+50.*y**2.-74.
G=4.*x**2.+25.*x*y**2.+10.*y-41.
dFx=32.*x+5.*ydFy=5.*x+100.*y
dGx=8.*x+25.*y**2.
dGy=50.*x*y+10.
ddFx=32.
ddFy=100.
ddFxy=5.
ddGx=8.
ddGy=50.*x
ddGxy=50.*yb(1,1)=-Fb(2,1)=-G
a2(1,1)=dFx-F*ddFx/(2.*dFx)-F*ddFxy/(2.*dFy)
a2(1,2)=dFy-F*ddFy/(2.*dFy)-F*ddFxy/(2.*dFx)
a2(2,1)=dGx-G*ddGx/(2.*dGx)-G*ddGxy/(2.*dGy)a2(2,2)=dGy-G*ddGy/(2.*dGy)-G*ddGxy/(2.*dGx)ccall crout(l,u,a2,n)call invu(iu,u,n)call invl(il,l,n)call matrix(n,iu,il,a2inv)
call matrix(n,a2inv,b,ddx2)
dx=ddx2(1,1)
dy=ddx2(2,1)
write(6,'(10f8.5)') x,y,dx,dy,F,G
if(abs(F).le.eps.and.abs(G).le.eps) go to 121
x=x+dxページ(1)

G'

02-5program.for.txt
y=y+dy200
continue
121
write(6,*) k,'回'
write(6,*) ' '
x=2.0
y=1.0
100 continue
stop
end
c
c---------------------------------------------subroutine crout(l,u,a,n)c
クラウト法を用いLU分解するサブルーチン
dimension a(10,10),l(10,10),u(10,10),d(10,10)
real
a,l,u,dinteger i,j,k,nc

do 10 i=1,ndo 10 j=1,nd(i,j)=a(i,j)
if(i.le.j) thendo 11 k=1,i-1
d(i,j)=d(i,j)-d(i,k)*d(k,j)
11continueif(i.lt.j) d(i,j)=d(i,j)/d(i,i)
else
do 12 k=1,j-1
d(i,j)=d(i,j)-d(i,k)*d(k,j)
12continueend if10 continue
L行列とU行列に要素を分ける
do 13 i=1,ndo 13 j=1,nif(i.ge.j) thenl(i,j)=d(i,j)
if(i.eq.j) thenu(i,j)=1.00
else
u(i,j)=0.00
end ifelse
u(i,j)=d(i,j)
l(i,j)=0.00
end if13 continue
returnendcc---------------------------------------------subroutine invl(il,l,n)c
下三角の逆行列を求めるサブルーチン
dimension il(10,10),l(10,10)
real
il,l
integer i,j,k,n
ページ(2)

02-5program.for.txt
do 30 i=1,ndo 30 j=1,nif(i.eq.j) il(i,j)=1.0/l(i,j)
if(i.lt.j) il(i,j)=0.0
if(i.gt.j) thenil(i,j)=0.0
do 31 k=1,i-1
il(i,j)=il(i,j)+l(i,k)*il(k,j)
31
continueil(i,j)=-il(i,j)/l(i,i)
end if30 continue
returnendcc---------------------------------------------subroutine invu(iu,u,n)c
上三角の逆行列を求めるサブルーチン
dimension iu(10,10),u(10,10)
real
iu,u
integer i,j,k,n
do 40 i=1,ndo 40 j=1,nif(i.eq.j) iu(i,j)=1.0
if(i.gt.j) iu(i,j)=0.0
if(i.lt.j) theniu(i,j)=0.0
do 41 k=i,j-1
iu(i,j)=iu(i,j)-iu(i,k)*u(k,j)
41
continueend if40 continue
returnendcc---------------------------------------------subroutine matrix(n,aa,bb,ab)c
行列の乗算を行うサブルーチン
real aa(10,10),bb(10,10),ab(10,10)c
do 15 i=1,ndo 15 j=1,nsum=0.0
do 16 k=1,nsum=aa(i,k)*bb(k,j)+sum
16 continueab(i,j)=sum
15 continue
returnend

ページ(3)

02-6program.for.txt
c ********************************************************
c 第2回ゼミc
非線形方程式の数値解析法c
ニュートン法とベイリー法を併用した連立方程式の解法
cc 作成者 宮武 真由子
作成日 2004.5.29
c ********************************************************
c 一次微係数利用
c 二次微係数利用cc F=16*x**2+5*x*y+50*y**2-74
c G=4*x**2+25*x*y**2+10*y-41c-------------------------dimension a(10,10),b(10,10),ainv(10,10),ddx(10,10)
dimension l(10,10),il(10,10),u(10,10),iu(10,10)
real F,G,DFX,DFY,DGX,DGY,DDFX,DDFY,DDGX,DDGY,DDFXY,DDGXY,x,y,dx,dy
integer n
x=1.0
y=1.0
n=2.0
do 999 i=1,2open(2,file='out.dat',status='unknown')
write (2,*)'K XYDX
do K=1,100c -------- NEWTON METHOD -------F=16.0*x**2.0+5.0*x*y+50.0*y**2.0-74.0
G=4.0*x**2.0+25.0*x*y**2.0+10.0*y-41.0
DFX=32.0*x+5.0*y
DFY=5.0*x+100.0*y
DGX=8.0*x+25.0*y**2.0
DGY=50.0*x*y+10.0
DDFX=32.0
DDFY=100.0
DDGX=8.0
DDGY=50.0*x
DDFXY=5.0
DDGXY=50.0*ya(1,1)=DFXa(1,2)=DFY
a(2,1)=DGX
a(2,2)=DGY
b(1,1)=-Fb(2,1)=-G
call crout(l,u,a,n)call invu(iu,u,n)call invl(il,l,n)call matrix(n,iu,il,ainv)
call matrix(n,ainv,b,ddx)
dx=ddx(1,1)
dy=ddx(2,1)
c -------- BAILEY METHOD -------ページ(1)

DY

F

G'

02-6program.for.txta(1,1)=DFX-1/2.0*DDFX*dx-1/2.0*DDFXY*dya(1,2)=DFY-1/2.0*DDFY*dy-1/2.0*DDFXY*dx
a(2,1)=DGX-1/2.0*DDGX*dx-1/2.0*DDGXY*dya(2,2)=DGY-1/2.0*DDGY*dy-1/2.0*DDGXY*dxb(1,1)=-Fb(2,1)=-G
call crout(l,u,a,n)call invu(iu,u,n)call invl(il,l,n)call matrix(n,iu,il,ainv)
call matrix(n,ainv,b,ddx)
dx=ddx(1,1)
dy=ddx(2,1)
c ------------ OUTPUT -----------write (2,'(7f10.5)') x,y,DX,DY,F,Gc
IF (ABS(F).LE.1E-4.and.ABS(G).LE.1E-4) GO TO 100
x=x+dxy=y+dyend do100 continue
c
x=2.0
y=1.0
999 continue
stopendc---------------------------------subroutine crout(l,u,a,n)dimension a(10,10),l(10,10),u(10,10),d(10,10)
real
a,l,u,dinteger i,j,k,ndo 10 i=1,ndo 10 j=1,nd(i,j)=a(i,j)
if(i.le.j) thendo 11 k=1,i-1
d(i,j)=d(i,j)-d(i,k)*d(k,j)
11continueif(i.lt.j) d(i,j)=d(i,j)/d(i,i)
else
do 12 k=1,j-1
d(i,j)=d(i,j)-d(i,k)*d(k,j)
12continueend if10 continue
do 13 i=1,ndo 13 j=1,nif(i.ge.j) thenページ(2)

02-6program.for.txt
l(i,j)=d(i,j)
if(i.eq.j) thenu(i,j)=1.00
else
u(i,j)=0.00
end ifelse
u(i,j)=d(i,j)
l(i,j)=0.00
end if13 continue
returnendc---------------------------------subroutine invl(il,l,n)dimension il(10,10),l(10,10)
real
il,l
integer i,j,k,n
do 30 i=1,ndo 30 j=1,nif(i.eq.j) il(i,j)=1.0/l(i,j)
if(i.lt.j) il(i,j)=0.0
if(i.gt.j) thenil(i,j)=0.0
do 31 k=1,i-1
il(i,j)=il(i,j)+l(i,k)*il(k,j)
31
continueil(i,j)=-il(i,j)/l(i,i)
end if30 continue
returnendc---------------------------------subroutine invu(iu,u,n)dimension iu(10,10),u(10,10)
real
iu,u
integer i,j,k,n
do 40 i=1,ndo 40 j=1,nif(i.eq.j) iu(i,j)=1.0
if(i.gt.j) iu(i,j)=0.0
if(i.lt.j) theniu(i,j)=0.0
do 41 k=i,j-1
iu(i,j)=iu(i,j)-iu(i,k)*u(k,j)
41
continueend if40 continue
returnend
ページ(3)

02-6program.for.txt
c---------------------------------subroutine matrix(n,aa,bb,ab)
real aa(10,10),bb(10,10),ab(10,10)
do i=1,ndo j=1,nsum=0.0
do k=1,nsum=aa(i,k)*bb(k,j)+sum
end doab(i,j)=sum
end doend doreturnend

ページ(4)

02-7program.for.txt
c ********************************************************
c 第2回ゼミc
非線形方程式の数値解析法
c
不等流計算 1階ニュートン法
cc 作成者 東海林 勉
作成日 2004.5.29
c ********************************************************
c 一次微係数利用
real l1open(6,file='問題4(1).out',status='unknown')
write(6,*) '問題4 解答 1次微係数'
c② 地点
h1=4.5h2=4.5
aI1=2000.0
l1=1200.0
b1=300.0b2=280.0
write(6,*) '▽②地点'
call ftoryu (h1,h2,aI1,l1,B1,B2)
c
③地点
h1=h2
aI1=1500.0
l1=950.0b1=280.0b2=250.0
write(6,*) '▽③地点'
call ftoryu (h1,h2,aI1,l1,B1,B2)
c
④地点
h1=h2
aI1=700.0
l1=1350.0
b1=250.0b2=220.0
write(6,*) '▽④地点'
call ftoryu (h1,h2,aI1,l1,B1,B2)
stop
end
c
c*****************************************************
subroutine ftoryu (h1,h2,aI1,l1,B1,B2)
real l1a=1.0
q=300.0
an=0.025
g=9.8
eps=0.00001
AA=(A*Q**2)/(2*g*B2**2)
BB=(an**2*Q**2*l1)/(2*B2**2)
write(6,*) 'h2f(h2)f´(h2)Δh2 'F1=h1-l1/aI1+(a*Q**2.0)/(2.0*g*B1**2*h1**2.0)& +(an**2.0*Q**2.0*l1)/(2.0*B1**2.0*h1**(10.0/3.0))
do 1 i=1,30
F2=h2+(AA/(h2**2.0))-(BB/(h2**(10.0/3.0)))
dF2=1.0-2.0*AA/(h2**3.0)+(10.0*BB)/(3.0*h2**(13.0/3.0))
ff=F2-F1
dh2=-(ff/dF2)
write(6,'(7f10.5)') h2,ff,dF2,dh2
ページ(1)

02-7program.for.txt
if (ABS(ff).le.eps ) go to 100
h2=h2+dh2
1 continue
100 returnend

ページ(2)

02-8program.for.txt
c ********************************************************
c 第2回ゼミc
非線形方程式の数値解析法
c
不等流計算 2階ニュートン法
cc 作成者 東海林 勉
作成日 2004.5.29
c ********************************************************
c 二次微係数利用
real l1open(6,file='問題4(2).out',status='unknown')
write(6,*) '問題4 解答 <2次微係数>'c② 地点
h1=4.5h2=4.5
aI1=2000.0
l1=1200.0
b1=300.0b2=280.0
write(6,*) '▽②地点'
call ftoryu 2dimensions (h1,h2,aI1,l1,B1,B2)
c
③地点
h1=h2
aI1=1500.0
l1=950.0b1=280.0b2=250.0
write(6,*) '▽③地点'
call ftoryu 2dimensions (h1,h2,aI1,l1,B1,B2)
c
④地点
h1=h2
aI1=700.0
l1=1350.0
b1=250.0b2=220.0
write(6,*) '▽④地点'
call ftoryu 2dimensions (h1,h2,aI1,l1,B1,B2)
stop
end
c
c*****************************************************
subroutine ftoryu 2dimensions (h1,h2,aI1,l1,B1,B2)
real l1a=1.0
q=300.0
an=0.025
g=9.8
eps=0.0001
AA=(A*Q**2.0)/(2.0*g*B2**2.0)
BB=(an**2.0*Q**2.0*l1)/(2.0*B2**2.0)
F1=h1-l1/aI1+(a*Q**2.0)/(2.0*g*B1**2.0*h1**2.0)& +(an**2.0*Q**2.0*l1)/(2.0*B1**2.0*h1**(10.0/3.0))
write(6,*) '
h1
h2
f
df
ddf
do 1 i=1,5F2=h2+(AA/(h2**2.0))-(BB/(h2**(10.0/3.0)))
dF2=1.0-2.0*AA/(h2**3.0)+(10.0*BB)/(3.0*h2**(13.0/3.0))
ddF2=6.0*AA/(h2**4.0)-130.0*BB/(9.0*h2**(16.0/3.0))
F2=F2-F1
write(6,'(6f8.4)') h1,h2,F2,dF2,ddF2,dh2
ページ(1)dh'

02-8program.for.txt
if (ABS(F2).le.eps ) go to 100
dh2=(-dF2+(dF2**2.0-2.0*F2*ddF2)**0.5)/ddF2
dh3=(-dF2-(dF2**2.0-2.0*F2*ddF2)**0.5)/ddF2
h3=h2+dh2
h4=h2+dh3
F3=h3+(AA/(h3**2.0))-(BB/(h3**(10.0/3.0)))
F4=h4+(AA/(h4**2.0))-(BB/(h4**(10.0/3.0)))
if(F3.lt.F4) then
h2=h3
else
h2=h4
end if
1 continue
100 returnend

ページ(2)

06program.for.txt
c ********************************************************
c 第6回ゼミc
一価線形・非線形貯留関数法の最適化
c
一般化貯留関数モデルパラメータ同定c(1価の非線形貯留方程式のパラメータ最適化)
cc 作成者 東海林 勉
作成日 2004.8.6
c ********************************************************cc
k11 の最適化
c
一階ニュートン(newton)法
c
ヤコビアン(jacobian)行列（一次微係数）
c*****************************************cc
有効雨量と直接流出高の入力
cstorage-discharge relationshipcs = k11*q**p1c
optimization of parameters k11cp1 = 0.6c--------------------------------------------------------character suikei*80,kasenmei*80,chiten*80,flood*80cdimension er(200),uu(200),eu(200),pas(200)common/st1/wk,wp1,rain
common/st2/h
common/date/area,nq,nr,xnq
common/discha/r(200),qo(200),qc(200)common/keisu1/a1,f,g
open(1,file='input.dat',status='unknown')
open(6,file='1価非線形1次微係数による最適化.out',status='unknown')read(1,'(a80)') suikei!水系名
read(1,'(a80)') kasenmei!河川名
read(1,'(a80)') chiten!地点名
read(1,'(a80)') flood!洪水年月日read(1,'(f8.4)') area
!流域面積
read(1,'(f8.4)') rave
!平均有効雨量強度
read(1,'(2i8)') nr,nq!データ数(有効雨量・直接流出高)
read(1,'(8f10.6)') (r(i),i=1,nr) !有効雨量
read(1,'(8f10.6)') (qo(i),i=1,nq) !直接流出高cdata nl,kount,eps/6,20,0.001/!分割時間,繰返計算回数,収束条件
data wk10,wp10/22.7602,0.6/!パラメータK1初期値
c--OUTPUT 1
write(6,*)'1価の非線形貯留関数法（一階ニュートンによる最適化）'
write(6,'()')
write(6,'(''洪水:'',a80)') flood
write(6,'(''水系名:'',a80)') suikei
write(6,'(''河川名:'',a80)') kasenmei
write(6,'(''地点名:'',a80)') chiten
write(6,'()')
write(6,'('' データ数=''i3,''
時間間隔=1/'',i2)') nr,nl
write(6,'()')
write(6,210)
210 format(4x,'流域面積',3x,'平均有効雨量強度',4x,'k1初期値')
write(6,'(f10.1,2f16.4)') area,rave,wk10
write(6,'()')
ページ(1)

06program.for.txt
write(6,209)
209 format(3x,'回数',6x,'k',11x,'Δk',6x,'目的関数',6x,'RMSE',7x,&'KAI2')c----xnl=nl
h=1.0/xnl
wkz=1.0
wp1=1.0/wp10
xnq=nqdo 10 j=1,kountwk=wk10*wkz
u=0.0
x=0.0
eut=0.0
uut=0.0
sum=0.0
skai2=0.0
do 15 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ll)qq=qo(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)do 20 k=1,nl
c** solution of sensitivity equationccall nolin1(x,u,1)c
c** solution of system equationccall nolin1(x,u,2)cif(x.le.0.0) x=0.0
20 continuepas(ll)=u*x**(wp1-1.)*wp1!変数変換
pas(ll)=wk10*pas(ll)!規準化感度係数
qcc=x**wp1
qc(ll)=qcc
err=qq-qcc
er(ll)=err
eu(ll)=er(ll)*pas(ll)uu(ll)=pas(ll)**2
eut=eut+eu(ll)uut=uut+uu(ll)sum=sum+er(ll)**2
if(qq.eq.0.0) go to 15
erw=er(ll)/qs
skai2=skai2+erw**2
15 continue
xj=sum/xnq!目的関数
sum=sqrt(sum/xnq)!RMSE
skai2=skai2/xnq!KAI2
delwk=eut/uut
ck=delwk/wkz
write(6,'(i5,5f12.4)')j,wk,wk10*delwk,xj,sum,skai2if(abs(ck).lt.eps) go to 111
wkz=wkz+delwk
ページ(2)

06program.for.txt
10 continuec----111 rtot=0.0
qtot=0.0
qctot=0.0
do 1000 i=1,nr
rtot=rtot+r(i)1000 continue
do 1001 i=1,nq
c** total observed runoff depth
qtot=qtot+qo(i)c** total computed runoff depth
qctot=qctot+qc(i)1001 continue
call accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5)c--OUTPUT 2
write(6,'()')
write(6,211)
211 format(2x,'収束回数',2x,'k1最適値',5x,'目的関数',4x,'RMSE',& 8x,'KAI2',8x,'Jpe',9x,'Jre')write(6,'(i7,6f12.4)') j,wk,xj,sum,skai2,peakg,qsotai
write(6,'()')
write(6,214)
214 format(5x,'Ew',9x,'E',9x,'Ev',8x,'Ep')
write(6,'(4f10.4)')qsotai2,qsotai3,qsotai4,qsotai5
write(6,'()')
write(6,212)
212 format(4x,'比流量',3x,'総雨量',4x,'観測総流出',3x,'計算総流出',3x,&'観測ピーク値',3x,'計算ピーク値')
write(6,'(f10.4,2f9.2,3f14.2)') hiryu,rtot,qtot,qctot,qmax,qqmax
write(6,'()')
write(6,213)
213 format(x,'No',4x,'有効雨量',3x,'直接流出高',4x,'計算流出高')
do i=1,nq
write(6,'(i3,4f12.4)') i,r(i),qo(i),qc(i)end dostop
endc---------------------------------------------subroutine nolin1(x,u,ijk)c**
ijk = 1; solve sensitivity equationc**ijk = 2; solve system equationcommon/st1/wk,wp1,rain
common/st2/h
common/keisu1/a1,f,gc
y1=xc
if(y1.gt.0.0) go to 12cif(y1.lt.0.0) y1=0.0c
go to 14a1=y1**(wp1-1.0)
c=y1**wp1
a=-wp1*a1/wk
b=(c-rain)/(wk**2)
ページ(3)

06program.for.txt
d=(wp1-1.0)*c/wk+rain/wkc**elements of phi
f=exp(a*h)
c**elements of gamma
g=hif(a.ne.0.0) g=(exp(a*h)-1.0)/a
if(ijk.eq.2) go to 104
c**solve sensitivity equation
u1=f*u+g*b
u=u1
returnc**solve system equation
104 y=f*x+g*d
x=yreturnendc---------------------------------------------subroutine accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5)common/discha/r(200),qo(200),qc(200)common/date/area,nq,nr,xnq
qsotai=0.0
qsotai2=0.0
qsotai3=0.0
qmaxo=-999.99
qmaxc=-999.99
do 502 i=1,nq
if(qo(i).gt.qmaxo) qmaxo=qo(i)!観測ピークif(qc(i).gt.qmaxc) qmaxc=qc(i)!計算ピーク502 continue
qmax=qmaxo*area/3.6
qqmax=qmaxc*area/3.6
iko=0.0
do 501 i=1,nq
if(qo(i).lt.0.04) go to 500
iko=iko+1
qsotai=qsotai+abs(qo(i)-qc(i))/qo(i)qsotai2=qsotai2+((qo(i)-qc(i))/qo(i))**2
500 continue
qsotai3=qsotai3+((qo(i)-qc(i))/qmaxo)**2
501 continue
xiko=ikohiryu=qmax/area!比流量peakg=abs(qmaxo-qmaxc)/qmaxo!JPE
qsotai=qsotai/xiko!JREqsotai2=qsotai2/xiko!Ewqsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmaxo-qmaxc)/qmaxo!Ep
returnend

ページ(4)

input.txt
湧別川
湧別川
丸瀬布
平成13年9月11日
802.0
1.699394
94
1.357979 1.953697
2.882503
3.260431 3.696010
2.562225
3.087481 4.413433
1.383602
1.556552 1.921669
0.416362
0.230600 0.704612
0.871157
0.435578 0.640556
0.000000
0.128111 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.003411 0.016374
0.8292410.960343 1.071099
1.738390
1.857268 1.920897
2.745701
2.658581 2.572659
1.886504
1.792466 1.671622
1.291139
1.269595 1.231183
0.985421
0.957754 0.922666
0.657983
0.613118 0.628866
0.542833
0.518979 0.508154
0.376090
0.336065 0.302652
0.236739
0.237942 0.194971
0.065021
0.080586 0.056255

1.979319

5.188506

4.810578

4.086749

3.971449

3.318081

3.446193

3.779282

3.113103

2.197108

4.195644

4.093155

0.871157

0.704612

0.813506

0.871157

1.729502

1.249085

0.640556

0.743045

0.416362

0.762262

0.992862

0.608528

0.743045

0.454795

0.416362

0.102489

0.000000

0.454795

0.064056

0.044839

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000
0.023523

0.000000
0.129497

0.0000000.230115

0.385174

0.590781

1.141725

1.191243

1.265854

1.401141

1.552027

2.025711

2.154036

2.350736

2.589758

2.642277

2.476555

2.315424

2.180500

2.080521

1.941551

1.610329

1.549916

1.472195

1.404925

1.330138

1.209932

1.155533

1.077776

1.049374

0.974257

0.858049

0.883587

0.769014

0.729123

0.717712

0.577852

0.586670

0.595585

0.551600

0.560320

0.459365

0.448736

0.419614

0.378855

0.368495

0.321444

0.299643

0.266719

0.296658

0.246708

0.169075

0.170033

0.144431

0.134804

0.109691

0.037168

0.018300

0.004383

ページ(1)

input.txt

ページ(2)

07-1program.for.txt
c ********************************************************
c 第7回ゼミc
二価の線形・非線形貯留関数法の最適化
c
一般化貯留関数モデルパラメータ同定c(2価の非線形貯留方程式のパラメータ最適化)
cc 作成者 星 清
作成日 2004.11.8
c ********************************************************
ccfriction factor fc の１次元探索c
一階ニュートン(newton)法
c
ヤコビアン(jacobian)行列（一次微係数）
c*****************************************cc
有効雨量と直接流出高の入力
ck11=2.8235*fc*area**0.24coptimize the friction factor fccc
k12=0.2835*k11**2*rave**(-0.2648)ccstorage-discharge relationshipcs = k11*q**p1 + k12*d(q**p2)/dtc
optimization of parameters k11 and k12cp1 = 0.6 and p2 = 0.4648c--------------------------------------------------------character suikei*128,kasenmei*128,chiten*128,flood*128cdimension pas(200,9),dpa(9)dimension x(9),u(18),z(9),co(9)ccommon/st1/wk1,wk2,wp1,wp2,rain
common/st2/n,m,m1,m2,h,h2,h3,h4
common/st3/nq,nr,xnq,areacommon/st4/alph3,alph4,alph5
common/discha/r(200),qo(200),qc(200),q00(200)copen(1,file='input.dat',status='unknown')
open(6,file='2価非線形1次微係数によるfc最適化.dat',status='&
unknown')cc
fc=friction factor
fc初期値
c**
kount=maximum number of iterations繰返回数c**
eps=convergence limit
収束条件
data fc,wp1,zp2 /1.5,0.6,0.4648/
data n,m,nr,nq,nl,kount,eps/2,1,94,94,6,20,0.001/cread(1,3) suikei!水系名
read(1,3) kasenmei!河川名
read(1,3) chiten!地点名
read(1,3) flood!洪水年月日3 format(a128)
read(1,'(f8.4)') area
!流域面積
read(1,2) (r(i),i=1,nr)!有効雨量
read(1,2) (qo(i),i=1,nq)!直接流出高2 format(8f10.0)ccrave = 平均雨量強度
nzero=0
ページ(1)

07-1program.for.txt
rtot=0.0
do 199 i=1,nr
if(r(i).eq.0.0) go to 199
nzero=nzero+1
rtot=rtot+r(i)199 continue
xnz=nzerorave=rtot/xnzccc

initial values of parametersalph1=2.8235*area**0.24
alph4=alph1
alph2=0.2835*rave**(-0.2648)
alph3=alph1**2*alph2ccnormalized parameters
yk1=fcco(1)=fc

c--OUTPUT 1
write(6,*)'2価の非線形貯留関数法（一階ニュートン法による(fc)最適化&）'
write(6,'()')
write(6,'(''洪水:'',a20)') flood
write(6,'(''水系名:'',a10)') suikei
write(6,'(''河川名:'',a10)') kasenmei
write(6,'(''地点名:'',a20)') chiten
write(6,'()')
write(6,'('' データ数=''i3,''
時間間隔=1/'',i2)') nq,nlwrite(6,'()')
write(6,210)
210 format(x,' 流域面積',3x,'雨量強度',2x,'fc初期値')
write(6,'(f10.1,3f10.4)') area,rave,yk1
write(6,'()')
write(6,777)
777 format(4x,'回数',4x,'fc',7x,'MSE',7x,'RMSE',6x,'KAI2')c----xnl=nl
h=1./xnl
h2=h**2h3=h2*hh4=h3*hm1=m+1m2=2*mxnq=nqwp2=1./zp2cc**
start optimization (newton method)cfac=0.0
do 999 kkll=1,kountccupdated parameters
wk1=alph1*yk1
zk2=alph3*yk1**2
wk2=1./zk2
alph5=2.*alph3*yk1
ページ(2)

07-1program.for.txt
ccinitial values
do 800 i=1,n
800 x(i)=0.0c
initial values of sensitivity coefficients
do 802 i=1,m2
802 u(i)=0.0cskai2=0.0
sum=0.0
su2=0.0
seu=0.0c
do 30 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ll)qq=qo(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)do 40 k=1,nlc**solution of sensitivity equationccall nolinfc(x,u,1)cc**solution of system equationccall nolinfc(x,u,2)cif(x(1).le.0.0) x(1)=0.0
40 continue
qcc=0.0
if(x(1).gt.0.0) qcc=x(1)**wp2
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)
c**computed direct runoff depthqc(ll)=qcc
err=qq-qcc
if(qq.eq.0.0) go to 49
erw=err/qs
skai2=skai2+erw**2
49 continue
sum=sum+err**2c**sensitivity coefficientsdo 42 i=1,m42 pas(ll,i)=cc*u(i)c**normalized sensitivity coefficients
do 43 i=1,m
43 pas(ll,i)=co(i)*pas(ll,i)
su2=su2+pas(ll,1)**2cc**error between observed and computed dischargespas(ll,m1)=err
seu=seu+pas(ll,m1)*pas(ll,1)30 continuecxj=sum/xnq!目的関数
skai2=skai2/xnq!KAI2
sum=sqrt(sum/xnq)!RMSE
ページ(3)

c**

07-1program.for.txt
solve the correction terms of parametersdpa(1)=seu/su2cz(1)=yk1cwrite(6,779) kkll,yk1,sum**2,sum,skai2779 format(1h ,i5,4f10.4)
do 875 i=1,m
col = abs(dpa(i)/z(i))
if(col.gt.eps) go to 877
875 continue
go to 879
877 fac = 0.5*(1.+fac)
do 878 i=1,mdpa(i)=fac*dpa(i)878 continue
do 991 i=1,mxnew=z(i)+dpa(i)if(xnew.gt.0.0) z(i)=z(i)+dpa(i)991 continue
yk1=z(1)c
999 continuec-------879 continue
rtot=0.0
do 1003 i=1,nr
rtot=rtot+r(i)1003 continue
qtot=0.0
qctot=0.0
do 1002 i=1,nq
c** total observed runoff depth
qtot=qtot+qo(i)!総実測流出高
c** total computed runoff depth
qctot=qctot+qc(i)!総計算流出高
1002 continueccall accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5) !精度評価指標cc--OUTPUT 2
write(6,'()')
write(6,211)
211 format(3x,'収束回数',3x,'k1',9x,'k2',10x,'MSE',9x,'RMSE',& 8x,'KAI2',8x,'Jpe',9x,'Jre')write(6,'(i7,7f12.4)') kkll,wk1,zk2,xj,sum,skai2,peakg,qsotai
write(6,'()')
write(6,214)
214 format(5x,'Ew',9x,'E',9x,'Ev',8x,'Ep')
write(6,'(4f10.4)')qsotai2,qsotai3,qsotai4,qsotai5
write(6,'()')
write(6,212)
212 format(4x,'比流量',3x,'総雨量',4x,'観測総流出',3x,'計算総流出',3x,&'観測ピーク値',3x,'計算ピーク値')
write(6,'(f10.4,2f9.2,3f14.2)') hiryu,rtot,qtot,qctot,qmax,qqmax
write(6,'()')
write(6,204)
ページ(4)

07-1program.for.txt
204 format(6x,'No',10x,'有効雨量',8x,'実測流出高',6x,'計算流出高')
do 205 i=1,nq
write(6,207) i,r(i),qo(i),qc(i)205 continue
207 format(i8,f16.4,5f16.4)
stop
end
c
c---------------------------------------------subroutine nolinfc(x,u,ijk)c**s = k11*q**p1 + k12*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equationc**ijk = 2; solve system equationcdimension x(1),u(1),y(9),uu(18),b(9)common/st1/wk1,wk2,wp1,wp2,rain
common/st2/n,m,m1,m2,h,h2,h3,h4
common/st4/alph3,alph4,alph5ccon=wk1*wk2*wp1*wp2
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
14 a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c
a2=-con*da3=a1+a2**2
a4=a1+a3c**elements of phi matrix (transition matrix)
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrix
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
if(ijk.eq.2) go to 104cc**solve sensitivity equationb(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e - rain)b3=alph4*b(1)+alph5*b(2)cuu(1)= f1*u(1) + f2*u(2) + g2*b3
uu(2)= f3*u(1) + f4*u(2) + g4*b3
do 20 i=1,m2
20 u(i)=uu(i)ページ(5)

07-1program.for.txt
return104 continuecc**solve system equation
b1=con*(wp1*wp2-1.)*d*y2+wk2*(wp2-1.)*e+wk2*raincy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
do 102 i=1,n102 x(i)=y(i)returnendcc---------------------------------------------subroutine accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5)common/st3/nq,nr,xnq,areacommon/discha/r(200),qo(200),qc(200),q00(200)qsotai=0.0
qsotai2=0.0
qsotai3=0.0
qmaxo=-999.99
qmaxc=-999.99
do 502 i=1,nq
if(qo(i).gt.qmaxo) qmaxo=qo(i)!観測ピークif(qc(i).gt.qmaxc) qmaxc=qc(i)!計算ピーク502 continue
qmax=qmaxo*area/3.6
qqmax=qmaxc*area/3.6
iko=0.0
do 501 i=1,nq
if(qo(i).lt.0.04) go to 500
iko=iko+1
qsotai=qsotai+abs(qo(i)-qc(i))/qo(i)qsotai2=qsotai2+((qo(i)-qc(i))/qo(i))**2
500 continue
qsotai3=qsotai3+((qo(i)-qc(i))/qmaxo)**2
501 continue
xiko=ikohiryu=qmax/area!比流量peakg=abs(qmaxo-qmaxc)/qmaxo!JPE
qsotai=qsotai/xiko!JREqsotai2=qsotai2/xiko!Ewqsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmaxo-qmaxc)/qmaxo!Ep
returnend

ページ(6)

input.txt
湧別川
湧別川
丸瀬布
平成13年9月11日
802.0
1.357979 1.953697
2.882503
3.260431 3.696010
2.562225
3.087481 4.413433
1.383602
1.556552 1.921669
0.416362
0.230600 0.704612
0.871157
0.435578 0.640556
0.000000
0.128111 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.003411 0.016374
0.8292410.960343 1.071099
1.738390
1.857268 1.920897
2.745701
2.658581 2.572659
1.886504
1.792466 1.671622
1.291139
1.269595 1.231183
0.985421
0.957754 0.922666
0.657983
0.613118 0.628866
0.542833
0.518979 0.508154
0.376090
0.336065 0.302652
0.236739
0.237942 0.194971
0.065021
0.080586 0.056255

1.979319

5.188506

4.810578

4.086749

3.971449

3.318081

3.446193

3.779282

3.113103

2.197108

4.195644

4.093155

0.871157

0.704612

0.813506

0.871157

1.729502

1.249085

0.640556

0.743045

0.416362

0.762262

0.992862

0.608528

0.743045

0.454795

0.416362

0.102489

0.000000

0.454795

0.064056

0.044839

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000
0.023523

0.000000
0.129497

0.0000000.230115

0.385174

0.590781

1.141725

1.191243

1.265854

1.401141

1.552027

2.025711

2.154036

2.350736

2.589758

2.642277

2.476555

2.315424

2.180500

2.080521

1.941551

1.610329

1.549916

1.472195

1.404925

1.330138

1.209932

1.155533

1.077776

1.049374

0.974257

0.858049

0.883587

0.769014

0.729123

0.717712

0.577852

0.586670

0.595585

0.551600

0.560320

0.459365

0.448736

0.419614

0.378855

0.368495

0.321444

0.299643

0.266719

0.296658

0.246708

0.169075

0.170033

0.144431

0.134804

0.109691

0.037168

0.018300

0.004383

ページ(1)

07-2program.for.txt
c ********************************************************
c 第7回ゼミc
二価の線形・非線形貯留関数法の最適化
c
一般化貯留関数モデルパラメータ同定c(2価の非線形貯留方程式のパラメータ最適化)
cc 作成者 星 清
作成日 2004.11.8
c ********************************************************
ccfriction factor fc の１次元探索c
ダビドン(davidon)法c
ヤコビアン(jacobian)行列（一次微係数）c
ヘイシアン(hessian)行列（二次微係数）
c*****************************************cc
有効雨量と直接流出高の入力
ck11=2.8235*fc*area**0.24coptimize the friction factor fccc
k12=0.2835*k11**2*rave**(-0.2648)ccstorage-discharge relationshipcs = k11*q**p1 + k12*d(q**p2)/dtc
optimization of parameters k11 and k12cp1 = 0.6 and p2 = 0.4648c------------------------------------------------character suikei*128,kasenmei*128,chiten*128,flood*128cdimension djo(5),ho(5,5),ddi(5),djo2(5,5),dpa(5)common/st1/r(100),qo(200),qc(200),er(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,rain
common/st4/alph3,alph4,alph5
common/st5/xj,skai2,co(5),z(5)copen(1,file='input.dat',status='unknown')
open(6,file='2価非線形ダビドン法によるfc最適化.dat',status='&
unknown')cc
fc=friction factor
fc初期値
c**
kount=maximum number of iterations繰返回数c**
eps=convergence limit
収束条件
data fc,wp1,zp2/1.5,0.6,0.4648/
data n,m,nr,nq,nl,kount,eps/2,1,94,94,6,20,0.001/cread(1,3) suikei!水系名
read(1,3) kasenmei!河川名
read(1,3) chiten!地点名
read(1,3) flood!洪水年月日3 format(a128)
read(1,'(f8.4)') area
!流域面積
read(1,2) (r(i),i=1,nr)!有効雨量
read(1,2) (qo(i),i=1,nq)!直接流出高2 format(8f10.0)ccrave = 平均雨量強度
nzero=0
rtot=0.0
ページ(1)

07-2program.for.txt
do 199 i=1,nr
if(r(i).eq.0.0) go to 199
nzero=nzero+1
rtot=rtot+r(i)199 continue
xnz=nzerorave=rtot/xnzccc

initial values of parametersalph1=2.8235*area**0.24
alph4=alph1
alph2=0.2835*rave**(-0.2648)
alph3=alph1**2*alph2ccnormalized parameters
yk1=fcco(1)=fccc--OUTPUT 1
write(6,*)'2価の非線形貯留関数法（ダビドン法による(fc)最適化）'
write(6,'()')
write(6,'(''洪水:'',a20)') flood
write(6,'(''水系名:'',a10)') suikei
write(6,'(''河川名:'',a10)') kasenmei
write(6,'(''地点名:'',a20)') chiten
write(6,'()')
write(6,'('' データ数=''i3,''
時間間隔=1/'',i2)') nq,nlwrite(6,'()')
write(6,210)
210 format(x,' 流域面積',3x,'雨量強度',2x,'fc初期値')
write(6,'(f10.1,3f10.4)') area,rave,yk1
write(6,'()')
write(6,777)
777 format(4x,'回数',4x,'fc',7x,'MSE',7x,'RMSE',6x,'KAI2')c----cxnl=nlh=1./xnl
h2=h**2h3=h2*hh4=h3*hm1=m+1m2=2*mxnq=nqwp2=1./zp2cc**
start optimization (davidon method)cfac=0.0
do 999 kkll=1,kountccupdated parameters
wk1=alph1*yk1
zk2=alph3*yk1**2
wk2=1./zk2
alph5=2.*alph3*yk1c
ページ(2)

07-2program.for.txt
call davidonfc(sum,djo,djo2,ho)
c
c
c
c
c
c

sum: objective function
djo: jacobian matrix of objective function
djo2: hessian matrix of objective function
ho: inverse mmatrix of djo2
z(1)=yk1
solve the correction terms of parameters
do 932 i=1,mddi(i)=0.0
do 934 j=1,m
934 ddi(i)=ddi(i)+ho(i,j)*djo(j)dpa(i)=-ddi(i)932 continuec**cwrite(6,779) kkll,yk1,xj,sum,skai2779 format(1h ,i5,4f10.4)
do 875 i=1,m
col = abs(dpa(i)/z(i))
if(col.gt.eps) go to 877
875 continue
go to 879
877 fac = 0.5*(1.+fac)
do 878 i=1,mdpa(i)=fac*dpa(i)878continue
do 991 i=1,mxnew=z(i)+dpa(i)if(xnew.gt.0.0) z(i)=z(i)+dpa(i)991 continue
yk1=z(1)c
999 continue
879 continuecrtot=0.0
do 1003 i=1,nr
rtot=rtot+r(i)1003 continuecqtot=0.0
qctot=0.0
do 1002 i=1,nq
c** total observed runoff depth
qtot=qtot+qo(i)!総実測流出高
c** total computed runoff depth
qctot=qctot+qc(i)!総計算流出高
1002 continueccall accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5) !精度評価指標cc--OUTPUT 2
write(6,'()')
write(6,211)
211 format(3x,'収束回数',3x,'k1',9x,'k2',10x,'MSE',9x,'RMSE',& 8x,'KAI2',8x,'Jpe',9x,'Jre')ページ(3)

07-2program.for.txt
write(6,'(i7,7f12.4)') kkll,wk1,zk2,xj,sum,skai2,peakg,qsotai
write(6,'()')
write(6,214)
214 format(5x,'Ew',9x,'E',9x,'Ev',8x,'Ep')
write(6,'(4f10.4)')qsotai2,qsotai3,qsotai4,qsotai5
write(6,'()')
write(6,212)
212 format(4x,'比流量',3x,'総雨量',4x,'観測総流出',3x,'計算総流出',3x,&'観測ピーク値',3x,'計算ピーク値')
write(6,'(f10.4,2f9.2,3f14.2)') hiryu,rtot,qtot,qctot,qmax,qqmax
write(6,'()')
write(6,204)
204 format(6x,'No',10x,'有効雨量',8x,'実測流出高',6x,'計算流出高')
do 205 i=1,nq
write(6,207) i,r(i),qo(i),qc(i)205 continue
207 format(i8,f16.4,5f16.4)
stop
end
c
c---------------------------------------------subroutine davidonfc(sum,djp,dj2,pin)cfirst and second derivatives of objective function incterms of parametersccompute the hessian matrix of objective function (dj2)cand its inverse matrix (pin)dimension djp(5),x(2),u(10),pax(5),uq2(4,4),ho(4,4)
dimension u1(4)dimension dj2(5,5),pp(5,5),pin(5,5)
common/st1/r(100),qo(200),qc(200),er(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,rain
common/st4/alph3,alph4,alph5
common/st5/xj,skai2,co(5),z(5)csum=0.0
skai2=0.0c
do 900 i=1,m
djp(i)=0.0
do 902 j=i,mho(i,j)=0.0
902 continue
900 continuecinitial values of states
do 800 i=1,n
800 x(i)=0.0c
initial values of sensitivity coefficients
do 802 i=1,m2
802 u(i)=0.0
do 804 i=1,m2
u1(i)=0.0
804 continuecdo 30 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ll)qq=qo(ll)ページ(4)

c**c**c

07-2program.for.txt
qs=0.0if(qq.gt.0.0) qs=sqrt(qq)do 40 k=1,nl
solutions of sensitivity equation(first and second derivatives)
call nolinfc(x,u,u1,1)

c
c**
c

solution of system equation
call nolinfc(x,u,u1,2)cif(x(1).le.0.0) x(1)=0.0
40 continue
qcc=0.0
cc=0.0
cc1=0.0
if(x(1).le.0.0) go to 41
qcc=x(1)**wp2
cc=wp2*x(1)**(wp2-1.)
cc1=wp2*(wp2-1.)*x(1)**(wp2-2.)
41 continue
c**computed direct runoff depthqc(ll)=qcc
err=qq-qcc
er(ll)=err
if(qq.eq.0.0) go to 49
erw=err/qs
skai2=skai2+erw**2
49 continue
sum=sum+err**2cfirst sensitivity coefficientsdo 910 i=1,m
910 pax(i)=cc*u(i)csecond sensitivity coefficientsdo 911 i=1,m
do 911 j=i,muq2(i,j)=cc*u1(i)+cc1*u(i)*u(j)911 continuechessian matrix
do 912 i=1,m
do 912 j=i,mho(i,j)=ho(i,j)+err*uq2(i,j)-pax(i)*pax(j)912 continuecjacobian matrix
do 920 i=1,m
920 djp(i)=djp(i)+err*pax(i)30 continueccobjective functioncxj=sum/xnq!目的関数
skai2=skai2/xnq!KAI2
sum=sqrt(sum/xnq)
!RMSE
c
c
jacobian matrix of objective function
cin terms of standardized parameters
do 930 i=1,m
ページ(5)

07-2program.for.txt
930 djp(i)=-2.*co(i)*djp(i)/xnqchessian matrix of objective function
do 932 i=1,m
do 932 j=i,mdj2(i,j)=-2.*co(i)*co(j)*ho(i,j)/xnq
932 continue
do 935 i=1,m
do 935 j=1,m
935 pp(i,j)=dj2(i,j)
cccompute the inverse(pin) of hessian matrix(pp)cdo 937 i=1,m
do 937 j=1,m
937 pin(i,j)=1./pp(i,j)
creturnendcc---------------------------------------------subroutine nolinfc(x,u,u1,ijk)cc**
ijk = 1; solve sensitivity equations in terms ofcfirst derivatives(jacobian matrix) andcsecond derivatives(hessian matrix)cc**ijk = 2; solve system equationcc**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)cdimension x(1),u(1),uu(9),y(9),b(9)dimension u1(4),uu1(4),ua(4)dimension ccc(2,2),dz(2,2),dw(2,2),db(2,2)
dimension ak(4),bk(4)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,rain
common/st4/alph3,alph4,alph5ccon=wk1*wk2*wp1*wp2
a=0.0
c=0.0
d=0.0
e=0.0
az=0.0ez=0.0cy1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
az=y1**(wp1*wp2-3.)
ez=y1**(wp2-2.)
ページ(6)

07-2program.for.txt
14 a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c
a2=-con*da3=a1+a2**2
a4=a1+a3c**elements of phi matrix (transition matrix)
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrix
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
if(ijk.eq.2) go to 104cc**solve sensitivity equation(first derivatives)cb(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e - rain)cb3=alph4*b(1)+alph5*b(2)cuu(1)= f1*u(1) + f2*u(2) + g2*b3
uu(2)= f3*u(1) + f4*u(2) + g4*b3
do 20 i=1,m2
20 u(i)=uu(i)cc**solve hessian equation(second derivatives)
c2=wp1*wp2cc
ccc(i,j)=da1/dx (first derivatives in terms of x)c
ccc(1,1)=-con*(c2-1.)*(c2-2.)*az*y2&-wk2*wp2*(wp2-1.)*ez
ccc(1,2)=-con*(c2-1.)*a
ccc(2,1)=ccc(1,2)
ccc(2,2)=0.0ccdz(i,j)=da1/dk (first derivatives in terms of k)cdz(1,1)=-wk2*c2*(c2-1.)*a*y2
dz(1,2)=wk2*con*(c2-1.)*a*y2+wk2**2*wp2*cdz(2,1)=-wk2*c2*ddz(2,2)=wk2*con*dccdb(i,j)=db1/dx (=transpose of dz(i,j))c
do 306 i=1,m2
do 306 j=1,m2
306 db(j,i)=dz(i,j)
ccdw(i,j)=db/dk (first derivatives in terms of k)cdw(1,1)=0.0dw(1,2)=wk2**2*c2*d*y2
dw(2,1)=dw(1,2)
dw(2,2)=2.*wk2**3*(-wk1*c2*d*y2-e+rain)c
ページ(7)

c***cc

07-2program.for.txt
elements of forcing function in thesecond sensitivity equationua(1)=alph4ua(2)=alph5

c
c***
c

(dda1/ddfc)=(da1/dx)*u+(da1/dk)*ua

do 202 i=1,m2
s=0.0
do 195 k=1,m2
195 s=s+ccc(i,k)*u(k)+dz(i,k)*ua(k)ak(i)=s
202 continue
c
c***
c

(ddb1/ddfc)=(db1/dx)*u+(db1/dk)*ua

do 204 i=1,m2
s=0.0
do 206 k=1,m2
206 s=s+db(i,k)*u(k)+dw(i,k)*ua(k)bk(i)=s204 continue
c
c***
c

hhz=ut*ak(i)+uat*bk(i)s=0.0
do 209 k=1,m2
209 s=s+u(k)*ak(k)+ua(k)*bk(k)hhz=s+2.*alph3*b(2)cccuu1(i)= w(i);hessian matrix in terms of x1 and x2
uu1(1)=f1*u1(1)+f2*u1(2)+g2*hhz
uu1(2)=f3*u1(1)+f4*u1(2)+g4*hhz
do 224 i=1,m2
224 u1(i)=uu1(i)creturnc
104 continuec**solve system equation
b1=con*(wp1*wp2-1.)*d*y2+wk2*(wp2-1.)*e+wk2*raincy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
do 102 i=1,n102 x(i)=y(i)returnendcc---------------------------------------------subroutine accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5)common/st1/r(100),qo(200),qc(200),er(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,rain
ページ(8)

07-2program.for.txt
qsotai=0.0
qsotai2=0.0
qsotai3=0.0
qmaxo=-999.99
qmaxc=-999.99
do 502 i=1,nq
if(qo(i).gt.qmaxo) qmaxo=qo(i)!観測ピークif(qc(i).gt.qmaxc) qmaxc=qc(i)!計算ピーク502 continue
qmax=qmaxo*area/3.6
qqmax=qmaxc*area/3.6
iko=0.0
do 501 i=1,nq
if(qo(i).lt.0.04) go to 500
iko=iko+1
qsotai=qsotai+abs(qo(i)-qc(i))/qo(i)qsotai2=qsotai2+((qo(i)-qc(i))/qo(i))**2
500 continue
qsotai3=qsotai3+((qo(i)-qc(i))/qmaxo)**2
501 continue
xiko=ikohiryu=qmax/area!比流量peakg=abs(qmaxo-qmaxc)/qmaxo!JPE
qsotai=qsotai/xiko!JREqsotai2=qsotai2/xiko!Ewqsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmaxo-qmaxc)/qmaxo!Ep
returnend

ページ(9)

input.txt
湧別川
湧別川
丸瀬布
平成13年9月11日
802.0
1.357979 1.953697
2.882503
3.260431 3.696010
2.562225
3.087481 4.413433
1.383602
1.556552 1.921669
0.416362
0.230600 0.704612
0.871157
0.435578 0.640556
0.000000
0.128111 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.000000
0.000000 0.000000
0.003411 0.016374
0.8292410.960343 1.071099
1.738390
1.857268 1.920897
2.745701
2.658581 2.572659
1.886504
1.792466 1.671622
1.291139
1.269595 1.231183
0.985421
0.957754 0.922666
0.657983
0.613118 0.628866
0.542833
0.518979 0.508154
0.376090
0.336065 0.302652
0.236739
0.237942 0.194971
0.065021
0.080586 0.056255

1.979319

5.188506

4.810578

4.086749

3.971449

3.318081

3.446193

3.779282

3.113103

2.197108

4.195644

4.093155

0.871157

0.704612

0.813506

0.871157

1.729502

1.249085

0.640556

0.743045

0.416362

0.762262

0.992862

0.608528

0.743045

0.454795

0.416362

0.102489

0.000000

0.454795

0.064056

0.044839

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000

0.000000
0.023523

0.000000
0.129497

0.0000000.230115

0.385174

0.590781

1.141725

1.191243

1.265854

1.401141

1.552027

2.025711

2.154036

2.350736

2.589758

2.642277

2.476555

2.315424

2.180500

2.080521

1.941551

1.610329

1.549916

1.472195

1.404925

1.330138

1.209932

1.155533

1.077776

1.049374

0.974257

0.858049

0.883587

0.769014

0.729123

0.717712

0.577852

0.586670

0.595585

0.551600

0.560320

0.459365

0.448736

0.419614

0.378855

0.368495

0.321444

0.299643

0.266719

0.296658

0.246708

0.169075

0.170033

0.144431

0.134804

0.109691

0.037168

0.018300

0.004383

ページ(1)

09program.for.txt
c ********************************************************
c 第9回ゼミc
損失項を含む貯留関数法(1段タンク型貯留関数モデル)
cc 作成者 星 清、東海林 勉
作成日 2005.3.7
c ********************************************************cc
損失項を含む貯留関数法のパラメータ同定c***
モデル定数 c11, c12及び c13の同時最適化***
cc
一階ニュートン法（newton method）c
ヤコビアン(jacobian)行列（一次微係数使用）
c********************************************************
ccstorage-discharge relationshipcs = k11*q**p1 + k12*d(q**p2)/dt
c
ds/dt = r-q-b+q0
cq0=qb*exp(-ram*t)!基底流出量cqb = 初期流出高cram = ハイドログラフ低減部の減衰係数cb = k13*q (b = 損失高)ck11 = c11*A**(0.24)ck12 = c12*k11**2*(rave)**(-0.2648)cc13 = 1 + k13cp1 = 0.6 and p2 = 0.4648ccr= 観測雨量cq= 観測流量cc***********************************************************
coptimization of parameters c11, c12 and c13
c***********************************************************c--------------------------------------------------------character kouzui*128,suikei*128,kasen*128&,chiten*128cdimension q(200),pas(200,9),dpa(9),co(9)dimension x(9),u(18),z(9)ccommon/st1/r(200),q0(200),qc(200),er(200),q00(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain,q0incopen(1,file='input.dat',status='unknown')
open(5,file='損失項を含む貯留関数法.out',status='unknown')ccp1=0.6 p2=0.4648
data wp1,zp2/0.6,0.4648/
cc
write(5,*)'損失項を含む貯留関数法(1段タンク型貯留関数モデル)'
write(5,*)'一階ニュートン法(一次微係数使用)'
write(5,*)'モデル定数 c11, c12及び c13の同時最適化'
write(5,'()')
cc
ncase:計算洪水数
read(1,*) ncase
write(5,'(''計算洪水数：'',i3)') ncase
write(5,'()')
cページ(1)

09program.for.txt
do 9999 kk=1,ncasecread(1,3) suikei !水系名read(1,3) kasen !河川名read(1,3) chiten !観測所名read(1,3) kouzui !洪水名
c
cc
c
c
c
c
c
cc
cc

cc

area：流域面積
ipas：計算の実行判別(1:計算する 0:計算しない)
n:微分方程式の階数(n=2) m:モデル定数の個数(m=3) nl:分割数(nl=10)
kount:最大繰り返し回数(20) p:収束条件(p=0.001)
read(1,'(f8.0,i5)') area,ipas
read(1,4) n,m,nl,kount,pramda：ハイドログラフ低減部の減衰係数(ram)read(1,'(f8.0)')ram
初期値：c11,c12,c13
read(1,5) cc1,cc2,cc3
nr:雨量データ数 nq:流量データ数
read(1,'(2i5)') nr,nq
実測雨量データ入力
do i=1,nqr(i)=0.0
end doread(1,2) (r(i) ,i=1,nr)
実測流量データ入力(m3/s)
read(1,2) (q(i),i=1,nq)cc

流出高（mm/h）に変換
do 1001 i=1,nq
1001 q0(i)=3.6*q(i)/areacif(ipas.eq.0) go to 9999ccrave = 平均雨量強度
nzero=0
rtot=0.0
do 199 i=1,nr
if(r(i).eq.0.0) go to 199
nzero=nzero+1
rtot=rtot+r(i)199 continue
xnz=nzerorave=rtot/xnz
cc基準化パラメータ
yc1=1.0
yc2=1.0
yc3=1.0cco(1)=cc1
co(2)=cc2
co(3)=cc3c
1 format(4i8,4f8.0)
2 format(10f8.0)
3 format(a128)
4 format(4i5,2f8.0)
5 format(3f8.0)c
ページ(2)

09program.for.txt
write(5,'(''水系：'',a80)') suikei!水系
write(5,'(''河川名：'',a80)') kasen!河川名write(5,'(''観測地点：'',a80)') chiten!観測地点
write(5,'(''洪水年月日：'',a80)') kouzui!洪水年月日write(5,'()')
write(5,'('' 流量データ数=''i3,'', 計算時間間隔=1/'',i2)') nq,nlwrite(5,'()')
write(5,'(''λ(ramda)='',f8.4)') ram
write(5,'()')
write(5,210)
210 format('
流域面積',' 平均雨量強度',' c11初期値',' c12初期値',& 'c13初期値')
write(5,'(2f10.2,3f13.3)') area,rave,cc1,cc2,cc3c
xnl=nlh=1./xnl
h2=h**2h3=h2*hh4=h3*hm1=m+1m2=2*mxnq=nq
q01=q0(1)!初期流量
do 20 i=1,nq
q02=q0(1)*exp(-ram*i)q00(i)=(q01+q02)*0.5 !基底流出量q01=q0220 continuecwrite(5,'()')
write(5,'()')
write(5,*)'
No
c
c
c

c11

c12

c13

最適化開始 (一階ニュートン法)
fac=0.0
wp2=1./zp2
do 999 kkll=1,kount

c
c

c
c
800
c
802

モデル定数の更新
wk1=cc1*yc1*area**0.24
zk2=cc2*yc2*wk1**2*rave**(-0.2648)
wk2=1./zk2
wc3=cc3*yc3
状態変量初期値
do 800 i=1,nx(i)=0.0x(1)=q0(1)**zp2
感度係数初期値
do 802 i=1,m2
u(i)=0.0
sum=0.0
skai2=0.0c
do 30 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ll)ページ(3)

rmse

kai2'

09program.for.txt
q0in=q00(ll)qq=q0(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)do 40 k=1,nlc**solution of sensitivity equation
call gesto(x,u,1)c**solution of differential equation
call gesto(x,u,2)
if(x(1).le.0.0) x(1)=0.040
continue
qcc=0.0
if(x(1).gt.0.0) qcc=x(1)**wp2
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)c
計算流出高qc(ll)=qccc
誤差項
err=qq-qcc
er(ll)=err
if(qq.eq.0.0) go to 49
erw=err/qs
skai2=skai2+erw**2
49 continue
sum=sum+err**2c**sensitivity coefficientscpas(ll,1)=cc*u(1)*area**0.24!c11に関する感度係数
pas(ll,2)=cc*u(2)*wk1**2*rave**(-0.2648) !c12に関する感度係数
pas(ll,3)=cc*u(3)!c13に関する感度係数
c 規準化感度係数の計算
do 43 i=1,m43
pas(ll,i)=co(i)*pas(ll,i)cc**error between observed and computed dischargespas(ll,m1)=err
30
continuecskai2=skai2/xnq!kai2
sum=sqrt(sum/xnq)!rmsecwrite(5,779) kkll,cc1*yc1,cc2*yc2,cc3*yc3,sum,skai2779 format(1h ,i5,5f8.3)cz(1)=yc1z(2)=yc2z(3)=yc3c**component regression methodc**to solve the correction terms of parameterscall momreg(9,m1,200,nq,pas,dpa)
do 875 i=1,m
col = abs(dpa(i)/z(i))
if(col.gt.p) go to 877
875
continue
go to 879
877
fac = 0.5*(1.+fac)
do 878 i=1,mdpa(i)=fac*dpa(i)ページ(4)

878

991

999
879
c

09program.for.txt
continue
do 991 i=1,mxnew=z(i)+dpa(i)if(xnew.gt.0.0) z(i)=z(i)+dpa(i)continue
yc1=z(1)yc2=z(2)yc3=z(3)continue
continue

qtot=0.0
qctot=0.0
do 1002 i=1,nq
c** total observed runoff depth
qtot=qtot+q0(i)!総実測流出高
c** total computed runoff depth
qctot=qctot+qc(i)!総計算流出高
1002 continueccall accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5) !精度評価指標cc--OUTPUT 2
write(5,'()')
write(5,211)
211 format(3x,'収束回数',4x,'c11',9x,'c12',9x,'c13',&8x,'rmse',8x,'kai2',9x,'Jpe',9x,'Jre')write(5,'(i7,8f12.3)') kkll,cc1*yc1,cc2*yc2,cc3*yc3,&sum,skai2,peakg,qsotai
write(5,'()')
write(5,214)
214 format(5x,'Ew',9x,'E',9x,'Ev',8x,'Ep')
write(5,'(4f10.3)')qsotai2,qsotai3,qsotai4,qsotai5
write(5,'()')
write(5,212)
212 format(4x,'比流量',3x,'総雨量',4x,'観測総流出',3x,'計算総流出',3x,&'観測ピーク値',3x,'計算ピーク値')
write(5,'(3f10.3,4f15.3)') hiryu,rtot,qtot,qctot,qmax,qqmax
write(5,'()')
write(5,'()')
write(5,204)c
204 format('NO',6x,'実測雨量',6x,'実測流出高',6x,'計算流出高'& ,6x,'基底流出高',8x,'損失高')c
do i=1,nq
write(5,207) i,r(i),q0(i),qc(i),q00(i),qc(i)*(cc3*yc3-1.0)
end do207 format(i8,f12.2,5f16.4)
c9999 continue
c
stop
end
c
c-----------------------------------------------subroutine accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,
ページ(5)

09program.for.txt& qsotai,qsotai2,qsotai3,qsotai4,qsotai5)ccommon/st1/r(200),q0(200),qc(200),er(200),q00(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain,q0in
qsotai=0.0
qsotai2=0.0
qsotai3=0.0
qmaxo=-999.99
qmaxc=-999.99
do 502 i=1,nqif(q0(i).gt.qmaxo) qmaxo=q0(i)!観測ピークif(qc(i).gt.qmaxc) qmaxc=qc(i)!計算ピーク502 continue
qmax=qmaxo*area/3.6
qqmax=qmaxc*area/3.6
iko=0.0
do 501 i=1,nqif(q0(i).lt.0.04) go to 500
iko=iko+1
qsotai=qsotai+abs(q0(i)-qc(i))/q0(i)qsotai2=qsotai2+((q0(i)-qc(i))/q0(i))**2
500 continue
qsotai3=qsotai3+((q0(i)-qc(i))/qmaxo)**2
501 continue
xiko=ikohiryu=qmax/area!比流量peakg=abs(qmaxo-qmaxc)/qmaxo!Jpe（ピーク相対誤差）
qsotai=qsotai/xiko!Jre（ハイドログラフ相対誤差）
qsotai2=qsotai2/xiko!Ewqsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmaxo-qmaxc)/qmaxo!Ep
returnendcc-----------------------------------------------subroutine gesto(x,u,ijk)
ccc
損失項を含む貯留関数法(1段タンク型貯留関数モデル）cのパラメータ同定ccc**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)cc**********************************************************c
一階ニュートン法(newton method)cc
ヤコビアン(jacobian)行列（一次微係数）
cc**********************************************************c**ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18),b(9)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain,q0inc
con=wk1*wk2*wp1*wp2
a=0.0
c=0.0
ページ(6)

12

14

c**

c**

c**

16
18
20
104
c**

102

09program.for.txt
d=0.0
e=0.0
y1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c*wc3
a2=-con*da3=a1+a2**2
a4=a1+a3
elements of phi matrix (transition matrix)
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
elements of gamma matrix
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
if(ijk.eq.2) go to 104
solve sensitivity equationb(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e*wc3 - rain-q0in)b(3)=-wk2*e
do 16 i=1,muu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
uu(i) = f3*u(i-m) + f4*u(i) + g4*b(i-m)
do 20 i=1,m2
u(i)=uu(i)returncontinue
solve system equation
b1=con*(wp1*wp2-1.)*d*y2+wk2*wc3*(wp2-1.)*e+wk2*(rain+q0in)
y(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
do 102 i=1,nx(i)=y(i)returnendcc-----------------------------------------------subroutine momreg(n1,n,m1,md,x,dpa)
c**component regression methodc**compute the correction terms of parameters (dpa)
dimension x(m1,n1),dpa(1),cov(9,9),g(200,9),y(200,9)
dimension binv(9,9),coe(9),st(9)cna=n-1c**compute covariance matrix
call sqcov(n1,na,m1,md,x,cov)
do 50 i=1,na50
st(i)=sqrt(cov(i,i))
ページ(7)

52
c**
c**
c**
c**

54

22
20

26
24

29
30

09program.for.txt
do 52 i=1,na
s=st(i)do 52 j=1,i
s1=st(j)cov(i,j)=cov(i,j)/(s*s1)
cov(j,i)=cov(i,j)
factorization of cov(i,j) by lower triangularcholesky method (cov = l * u)l = lower triangular u = upper triangularcompute the inverse of u(i,j)
call lowtri(n1,na,cov,binv)
do 54 j=1,na
s=st(j)do 54 i=1,mdy(i,j)=x(i,j)/s
do 20 i=1,md
do 20 j=1,na
s=0.
do 22 k=1,js=s+y(i,k)*binv(k,j)
g(i,j)=s
do 24 i=1,na
s=0.0
do 26 j=1,md
s=s+g(j,i)*x(j,n)
coe(i)=s
do 30 i=1,na
s=0.
do 29 j=i,na
s=s+binv(i,j)*coe(j)dpa(i)=s/st(i)returnendcc-----------------------------------------------subroutine lowtri(n1,n,p,binv)c**lower triangular cholesky factorizationc**p = u*bc**p = symmetric matrixc**u = lower triangular matrixc**b = upper triangular matrix (b = ut)c**binv = inverse matrix of bc**
= upper triangular matrix
c**compute lower triangular u(i,j)
cdimension p(n1,n1),binv(n1,n1)
dimension u(9,9),b(9,9)
cdo 5 j=1,n-1u(j,j)=abs(p(j,j))u(j,j)=sqrt(u(j,j))al=1./u(j,j)
do 5 k=n,j+1,-1u(k,j)=al*p(k,j)
be=u(k,j)
do 5 i=k,n5p(i,k)=p(i,k)-u(i,j)*beu(n,n)=abs(p(n,n))
ページ(8)

09program.for.txt
u(n,n)=sqrt(u(n,n))
c
c**
40
c
c**

52
50

b = transpose of u
do 40 i=1,ndo 40 j=i,nb(i,j)=u(j,i)
compute inverse of b(i,j)
binv(1,1)=1./b(1,1)
do 50 j=2,nbinv(j,j)=1./b(j,j)
jm1=j-1
do 50 k=1,jm1
sum=0.0
do 52 i=k,jm1
sum = sum - binv(k,i)*b(i,j)
binv(k,j)=sum*binv(j,j)
returnendcc-----------------------------------------------subroutine sqcov(n1,n,m1,md,x,cov)c**compute covariance matrix
dimension x(m1,n1),cov(n1,n1)
do 10 i=1,ndo 10 j=1,is=0.
do 12 k=1,md12
s=s+x(k,i)*x(k,j)
10
cov(i,j)=s
returnend

ページ(9)

input.txt
1
湧別川
湧別川
丸瀬布
平成13年9月11日
802.0
1
2
3
10
0.014
10.0000.150
144 144
0.00
0.00
0.00
0.00
0.00
2.12
3.05
3.09
5.18
5.38
5.90
1.36
1.10
1.27
1.16
0.65
0.36
0.68
1.00
0.71
0.10
0.07
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
9.40
9.40
9.09
9.09
9.09
12.43
16.30
18.86
275.79287.79 305.39
554.89609.12 621.79
473.50462.21 442.24
333.57325.99 322.23
251.65258.31 233.77
202.94194.12 197.04
162.12164.79 156.84

200.0010

1.500
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.10

0.34

0.00

0.65

4.07

3.45

4.05

8.10

7.51

6.38

6.20

4.50

5.09

5.77

4.86

3.43

4.00

4.82

6.89

6.55

6.39

2.16

2.43

3.00

1.36

2.70

1.95

1.00

1.10

0.65

1.19

1.55

0.95

1.16

1.36

0.65

0.16

0.00

0.71

0.00

0.20

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
9.40

0.00
9.09

9.09

9.09

9.09

9.09

9.09

8.78

8.78

9.09

9.09

9.40

9.72

10.69

43.45

66.84

102.36149.14203.24233.43259.08336.51

371.10413.59441.05456.20480.53510.10645.81627.38609.21588.78553.86524.78503.48416.29403.62391.13374.80360.79345.10337.39311.09294.74289.39273.63277.10271.91265.07225.86224.29211.96202.94207.43197.04199.98194.12189.78188.35178.45177.06171.55163.45150.38155.54151.66145.30152.95142.80141.55

ページ(1)

input.txt
142.80134.20107.83104.61
89.21
88.23
73.51
71.46
59.64
59.64

129.41130.60125.87

124.70120.08111.11115.55111.11102.48102.48101.43

98.30

97.27

95.22

93.19

90.20

85.31

82.44

80.56

80.56

78.69

79.62

78.69

75.94

71.46

70.58

68.84

67.98

67.98

66.27

65.42

61.27

58.84

58.84

57.25

ページ(2)

10program.for.txt
c ********************************************************
c 第10回ゼミ
cフィルター分離法を活用した2段タンク型貯留関数モデルc
地下水流出成分を含む貯留関数法
c(2段タンク型非線形貯留関数モデル) のパラメータ同定
cc 作成者 星 清、東海林 勉
作成日 2005.5.16
c ********************************************************
cc***
フィルター分離法による地下水流出成分分離***c***
表面・中間流出成分(非線形)に関して定数最適化***c***
地下水流出成分(線形)は最適化しない***c***
モデル定数 c11, c12及びc13の同時最適化***
cc
一階ニュートン法（newton method）c
ヤコビアン(jacobian)行列（一次微係数使用）
c*********************************************************c***surface-subsurface runoff componentcs1 = k11*q1**p1 + k12*d(q1**p2)/dtc
ds1/dt = r-q1-bcq1 = surface-subsurface runoff componentcb = k13*q1 (b = 地下水成分への浸透供給量)ck11 = c11*A**(0.24)ck12 = c12*k11**2*(rave)**(-0.2648)cc13 = 1 + k13cp1 = 0.6 and p2 = 0.4648
cc***groundwater flow componentcs2 = k21*q2 + k22*d(q2)/dtc
ds2/dt = b - q2cq2 = groundwater flow componentck21 = c1*k22c
k22 = k13/c0cc0 = (delta/tc)**2c
c1 = delta**2/tccc***q = q1 + q2 (total runoff)ccdelta(δ) = 減衰係数（非振動解条件）cδ= 2.1 を使用
c
tc = 地下水成分分離時定数ctc : ハイドログラフ低減部の減衰係数(λ：ramda)の逆数
cc***
入力条件 ；r= 観測雨量 ；q= 観測流量cc***********************************************************
coptimization of parameters c11, c12 and c13
c***********************************************************ccharacter suikei*128,kasen*128,& chiten*128,kouzui*128cdimension q(200),q1(200),q2(200),qr(200,20)
dimension pas(200,9),dpa(9),co(9)dimension x(9),u(18),z(9)ccommon/st1/r(200),q0(200),qc(200),er(200),qc1(200),qc2(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,area
ページ(1)

10program.for.txt
common/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st4/wk21,wk22,c00,c01
common/st5/sum,skai2copen(1,file='input.dat',status='unknown')
open(6,file='2段タンク(分離非線形).out',status='unknown')c
wp1=0.6
zp2=0.4648
delta=2.1ccc

write(6,*)'地下水流出成分を含む貯留関数法'
write(6,*)'(2段タンク型非線形貯留関数モデル)'
write(6,*)'フィルター分離法による地下水流出成分分離'
write(6,*)'一階ニュートン法(一次微係数使用)'
write(6,*)'モデル定数 c11, c12及びc13の同時最適化'
write(6,'()')
ncase:計算洪水数
read(1,*) ncase
write(6,'(''計算洪水数：'',i3)') ncase
write(6,'()')

cread(1,3) suikei !水系名read(1,3) kasen !河川名read(1,3) chiten !観測所名read(1,3) kouzui !洪水名
c
cc
c
c
c
c

area：流域面積
ipas：計算の実行判別(1:計算する 0:計算しない)
n:微分方程式の階数(n=2) m:モデル定数の個数(m=3) nl:分割数(nl=10)
kount:最大繰り返し回数(20) p:収束条件(p=0.001)
read(1,'(f8.0,i5)') area,ipas
read(1,4) n,m,nl,kount,ptc：流出成分分離時定数（ハイドログラフ低減部の減衰係数(ram)の逆数）
read(1,'(f8.0)') tc
初期値：c11,c12,c13
read(1,5) cc1,cc2,cc3
nr:雨量データ数 nq:流量データ数
read(1,'(2i5)') nr,nq
実測雨量データ入力
do i=1,nqr(i)=0.0
end doread(1,2) (r(i) ,i=1,nr)
実測流量データ入力(m3/s)
read(1,2) (q(i),i=1,nq)

c
cc
cc

cc
c
c

流出高（mm/h）に変換
do 1001 i=1,nq
1001 q0(i)=3.6*q(i)/area!実測流出高cnzero=0
rtot=0.0
do 199 i=1,nr
if(r(i).eq.0.0) go to 199
nzero=nzero+1!雨量の個数（0以外）
rtot=rtot+r(i)!総雨量
199 continue
ページ(2)

10program.for.txt
cc

xnz=nzerorave=rtot/xnz
基準化パラメータ
yc1=1.0
yc2=1.0
yc3=1.0!平均雨量強度c
co(1)=cc1
co(2)=cc2
co(3)=cc3c
1 format(4i8,4f8.0)
2 format(10f8.0)
3 format(a128)
4 format(4i5,2f8.0)
5 format(3f8.0)
cc--OUTPUT 1
write(6,'(''水系：'',a80)') suikei!水系
write(6,'(''河川名：'',a80)') kasen!河川名write(6,'(''観測地点：'',a80)') chiten!観測地点
write(6,'(''洪水年月日：'',a80)') kouzui!洪水年月日write(6,'()')
write(6,'('' 流量データ数 =''i3,'' 計算時間間隔 =1/'',i2)') nq,nlwrite(6,'()')
write(6,'(''分離時定数(Tc) ='',f8.2)') tc
write(6,'()')
write(6,'(''p1 ='',f8.4,'' p2 ='',f8.4)') wp1,zp2
write(6,'()')
write(6,210)
210 format('
流域面積',' 平均雨量強度',' c11初期値',' c12初期値',& 'c13初期値')
write(6,'(2f10.2,3f13.3)') area,rave,cc1,cc2,cc3
write(6,'()')
write(6,*)'
No
c11
c12
c13
rmse
kai2'
c
c
全流出高時系列の離散化データ作成
do 11 i=1,nq
do 21 j=1,nl
if(i.eq.1) thenqr(i,j)=q0(i)elseqr(i,j)=(q0(i-1)+q0(i))/2.
end if21 continue
11 continuec
xnl=nlh=1./xnl
h2=h**2h3=h2*hh4=h3*hm1=m+1m2=2*mcc--- フィルター分離法による地下水流出成分の分離 --c00=(delta/tc)**2
c01=delta**2/tc
ページ(3)

10program.for.txt
c

地下水流出成分の係数
aa1=-c00
aa2=-c01
aa3=aa1+aa2**2
aa4=aa1+aa3cc 地下水流出成分の計算
c** ２段目タンクのΦの値
ff1 = 1. +0.5*aa1*h2+aa1*aa2*h3/6.+aa1*aa3*h4/24.
ff2 = h*(1. + 0.5*aa2*h+aa3*h2/6.+aa2*aa4*h3/24.)
ff3 = aa1*ff2
ff4 = 1. +aa2*h+0.5*aa3*h2+aa2*aa4*h3/6.+&(aa1*aa3+aa2**2*aa4)*h4/24.
c** ２段目タンクのγの値
gg2 = h2*(0.5+aa2*h/6.+aa3*h2/24.)
gg4=ff2cy1=0.0y2=0.0nnn=0
x1=c00*q0(1)do 10 i=1,nq
do 20 j=1,nl
yy1=ff1*y1+ff2*y2+gg2*x1
yy2=ff3*y1+ff4*y2+gg4*x1
y1=yy1y2=yy2if(y1.le.0.0) y1=0.0
x1=c00*qr(i,j)
20 continuecc 表面・中間流出成分と地下水流出成分の分離
if(q0(i).ge.y1) thenq2(i)=y1!q2: 地下水流出成分(q2<q0→q2=y1)q1(i)=q0(i)-q2(i)!q1: 表面・中間流出成分
nnn=nnn+1
!分離時刻
else
q1(i)=0.0q2(i)=q0(i)!q2: 地下水流出成分(q2>q0→q2=q0)
end if10 continuec
wp2=1./zp2
fac=0.0
sum=0.0
skai2=0.0cc---- 1段目タンクにおける表面・中間流出成分の最適化---c
最適化データ数(nq = nnn)
nq0=nqnq=nnncc
最適化開始(一階ニュートン法)cdo 999 kkll=1,kountcc**
モデル定数の更新c
表面・中間流出成分(1段目タンク)の貯留係数
ページ(4)

10program.for.txt
wk1=cc1*yc1*area**0.24
zk2=cc2*yc2*wk1**2*rave**(-0.2648)
wk2=1./zk2
wc3=cc3*yc3c
c** 流量と感度係数の初期値設定
do 800 i=1,n800x(i)=0.0x(1)=q1(1)**zp2cdo 803 i=1,2*m803
u(i)=0.0c
do 30 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ll)qq=q1(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)cdo 40 k=1,nlc**solution of sensitivity equation !感度係数計算
call onetank(x,u,1)c**solution of differential equation !流出高計算
call onetank(x,u,2)
if(x(1).le.0.0) x(1)=0.0
40 continuecc** 表面・中間流出成分
qc1(ll)=0.0
if(x(1).gt.0.0) qc1(ll)=x(1)**wp2 !計算直接流出高
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)
c** 誤差項
err=q1(ll)-qc1(ll)er(ll)=err
if(qq.eq.0.0) go to 49
erw=err/qs
skai2=skai2+erw**2
49 continue
sum=sum+err**2cc**sensitivity coefficients of surface-subsurface runoff depthcin terms of c11,c12 and c13cpas(ll,1)=(cc*u(1))*area**0.24!c11に関する感度係数
pas(ll,2)=(cc*u(2))*wk1**2*rave**(-0.2648) !c12に関する感度係数
pas(ll,3)=cc*u(3)!c13に関する感度係数ccsensitivity coefficients of normalized parametersc**
規準化感度係数の計算
do 43 i=1,m43
pas(ll,i)=co(i)*pas(ll,i)cc**error between observed and computed dischargespas(ll,m1)=err
30
continuec
ページ(5)

10program.for.txt
xnq=nqskai2=skai2/xnq
sum=sqrt(sum/xnq)

!kai2
!rmse

c
write(6,779) kkll,cc1*yc1,cc2*yc2,cc3*yc3,sum,skai2779 format(1h ,i5,5f8.3)
c

c**
c**

875
877
878

991

z(1)=yc1z(2)=yc2z(3)=yc3
component regression method
to solve the correction terms of parameters(dpa)call momreg(9,m1,200,nq,pas,dpa)
do 875 i=1,m
col = abs(dpa(i)/z(i))
if(col.gt.p) go to 877
continue
go to 879
fac = 0.5*(1.+fac)
do 878 i=1,mdpa(i)=fac*dpa(i)continue
do 991 i=1,mxnew=z(i)+dpa(i)if(xnew.gt.0.0) z(i)=z(i)+dpa(i)continue
yc1=z(1)yc2=z(2)yc3=z(3)continue
continue

999879cc 表面・中間流出成分と地下水流出成分の再現計算(データ数 = nq)cnq=nq0xnq=nqcc 地下水流出成分(2段目タンク)の貯留係数
zk22=(wc3-1.0)/c00
wk22=1.0/zk22
wk21=c01*zk22cc 流量と感度係数の初期値設定
do 85 i=1,2*n85x(i)=0.0x(1)=q0(1)**zp2
do 87 i=1,2*m2
87u(i)=0.0cc*** 1段目タンクと2段目タンクの流出高を同時計算
do 130 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ll)do 140 k=1,nlc**solution of differential equation
call tanksto2(x,u,2)
if(x(1).le.0.0) x(1)=0.0
if(x(3).le.0.0) x(3)=0.0
ページ(6)

10program.for.txt
140
continuecc 表面・中間流出成分
qc1(ll)=0.0
if(x(1).gt.0.0) qc1(ll)=x(1)**wp2c
地下水流出成分qc2(ll)=x(3)c
全流出高(計算流出高)
qcc=qc1(ll)+qc2(ll)qc(ll)=qcc
130
continuecqtot=0.0
qctot=0.0
do 1002 i=1,nq
c** total observed runoff depth
qtot=qtot+q0(i)!総実測流出高
c** total computed runoff depth
qctot=qctot+qc(i)!総計算流出高
1002 continueccall accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5) !精度評価指標cc--OUTPUT 2
write(6,'()')
write(6,211)
211 format(3x,'収束回数',4x,'c11',9x,'c12',9x,'c13',&8x,'rmse',8x,'kai2',9x,'Jpe',9x,'Jre')write(6,'(i7,8f12.3)') kkll,cc1*yc1,cc2*yc2,cc3*yc3,&sum,skai2,peakg,qsotai
write(6,'()')
write(6,214)
214 format(5x,'Ew',9x,'E',9x,'Ev',8x,'Ep')
write(6,'(4f10.3)') qsotai2,qsotai3,qsotai4,qsotai5
write(6,'()')
write(6,212)
212 format(4x,'比流量',3x,'総雨量',4x,'観測総流出',3x,'計算総流出',3x,& '観測ピーク値',3x,'計算ピーク値')
write(6,'(3f10.3,f12.3,2f16.3,i14)') hiryu,rtot,qtot,qctot,qmax,& qqmax
write(6,'()')
write(6,'()')
write(6,204)
204 format(7x,'NO',6x,'実測雨量',7x,'実測流出高',5x,'地下水流出高',& 4x,'表面中間流出高',3x,'計算表面中間流出',3x,'浸透供給高',3x,&'計算地下水',2x,'計算全流出高<表中+地下>')cdo i=1,nq
write(6,207) i,r(i),q0(i),q2(i),q1(i),qc1(i),qc1(i)*(wc3-1.0),& qc2(i),qc(i)end do207 format(i8,f12.2,4f16.4,f19.4,3f16.4)
c
stop
end
c
c**********************************************************************
ページ(7)

10program.for.txt
subroutine onetank(x,u,ijk)
c-------------------------------------------------------------c
地下水流出成分を含む貯留関数法c
1段目タンクにおける非線形貯留関数モデルのパラメータ同定cc
一階ニュートン法（newton method）c
ヤコビアン(jacobian)行列（一次微係数使用）
c-------------------------------------------------------------c**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18),b(3)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rainccon=wk1*wk2*wp1*wp2
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 1412
a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2c
1段目タンクの係数
14a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c*wc3
a2=-con*da3=a1+a2**2
a4=a1+a3c**elements of phi matrix (transition matrix)c
1段目タンクのΦの値
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrixc
1段目タンクのγの値
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
cif(ijk.eq.2) go to 104cc**solve sensitivity equationc** 1段目タンクにおける感度係数の計算
c
感度方程式の強制項計算b(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e*wc3 - rain)b(3)=-wk2*e
do 16 i=1,m
16
uu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
ページ(8)

18
20
c
104
c**
c**

102

10program.for.txt
uu(i) = f3*u(i-m) + f4*u(i) + g4*b(i-m)
do 20 i=1,m2
u(i)=uu(i)returncontinue
solve system equation
1段目タンクの状態変量(y1,y2)の計算
b1=con*(wp1*wp2-1.)*d*y2+wk2*wc3*(wp2-1.)*e+wk2*rainy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
do 102 i=1,nx(i)=y(i)returnendccsubroutine tanksto2(x,u,ijk)cc*************************************************************c
地下水流出成分を含む貯留関数法
c(2段タンク型非線形貯留関数モデル)c
表面・中間流出成分と地下水流出成分の同時計算
c*************************************************************c**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18),b(9)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st4/wk21,wk22,c00,c01ccon=wk1*wk2*wp1*wp2
wk13=wc3-1.0
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)y3=x(3)y4=x(4)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 1412
a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2c
1段目タンクの係数
14a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c*wc3
a2=-con*da3=a1+a2**2
a4=a1+a3c
２段目タンクの係数
a5=-c00/wk13
a6=-c01
ページ(9)

c**
c

c**
c
c

c

10program.for.txt
a7=a5+a6**2
a8=a5+a7
elements of phi matrix (transition matrix)
1段目タンクのΦの値
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
elements of gamma matrix
1段目タンクのγの値
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
２段目タンクのΦの値
f5 = 1. +0.5*a5*h2+a5*a6*h3/6.+a5*a7*h4/24.
f6 = h*(1. + 0.5*a6*h+a7*h2/6.+a6*a8*h3/24.)
f7 = a5*f6
f8 = 1. +a6*h+0.5*a7*h2+a6*a8*h3/6.+&(a5*a7+a6**2*a8)*h4/24.
２段タンク目のγの値
g6 = h2*(0.5+a6*h/6.+a7*h2/24.)
g8=f6

cif(ijk.eq.2) go to 104
c
c**
c**
c

solve sensitivity equation
1段目タンクにおける感度係数の計算
感度方程式の強制項計算b(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e*wc3 - rain)b(3)=-wk2*e
do 16 i=1,m
16
uu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
18
uu(i) = f3*u(i-m) + f4*u(i) + g4*b(i-m)
c**
２段目タンクにおける感度係数の計算
c
感度方程式の強制項計算
m3=m2+mb(4)=c00*wp2*c*u(1)b(5)=c00*wp2*c*u(2)b(6)=c00*wp2*c*u(3)+(c00/wk13**2)*y3
do 17 i=1,m
17 uu(i+m2)= f5*u(i+m2) + f6*u(i+m3) + g6*b(i+m)
do 19 i=m1,m2
19 uu(i+m2) = f7*u(i+m) + f8*u(i+m2) + g8*b(i)do 20 i=1,2*m220u(i)=uu(i)returnc
104
continuec**solve system equationc**
1段目タンクの状態変量(y1,y2)の計算
b1=con*(wp1*wp2-1.)*d*y2+wk2*wc3*(wp2-1.)*e+wk2*rainy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
c**
２段目タンクの状態変量(y3,y4)の計算
b2=c00*ey(3) = f5*x(3)+f6*x(4)+g6*b2
ページ(10)102

10program.for.txt
y(4) = f7*x(3)+f8*x(4)+g8*b2
do 102 i=1,2*nx(i)=y(i)returnendccc*********************************************************************
subroutine momreg(n1,n,m1,md,x,dpa)
c**component regression methodc**compute the correction terms of parameters (dpa)
dimension x(m1,n1),dpa(1),cov(9,9),g(200,9),y(200,9)
dimension binv(9,9),coe(9),st(9)cna=n-1c**compute covariance matrix
call sqcov(n1,na,m1,md,x,cov)
do 50 i=1,na50
st(i)=sqrt(cov(i,i))
do 52 i=1,na
s=st(i)do 52 j=1,i
s1=st(j)cov(i,j)=cov(i,j)/(s*s1)
52
cov(j,i)=cov(i,j)
c**factorization of cov(i,j) by lower triangularc**cholesky method (cov = l * u)c**l = lower triangular u = upper triangularc**compute the inverse of u(i,j)
call lowtri(n1,na,cov,binv)
do 54 j=1,na
s=st(j)do 54 i=1,md
54
y(i,j)=x(i,j)/s
do 20 i=1,md
do 20 j=1,na
s=0.
do 22 k=1,j22
s=s+y(i,k)*binv(k,j)
20
g(i,j)=s
do 24 i=1,na
s=0.0
do 26 j=1,md
26
s=s+g(j,i)*x(j,n)
24coe(i)=s
do 30 i=1,na
s=0.
do 29 j=i,na29
s=s+binv(i,j)*coe(j)30dpa(i)=s/st(i)returnendcc********************************************************************
subroutine lowtri(n1,n,p,binv)c**lower triangular cholesky factorizationc**p = u*bc**p = symmetric matrix
ページ(11)

c**
c**
c**
c**
c**
c

10program.for.txt
u = lower triangular matrixb = upper triangular matrix (b = ut)
binv = inverse matrix of b
= upper triangular matrix
compute lower triangular u(i,j)
dimension p(n1,n1),binv(n1,n1)
dimension u(9,9),b(9,9)

c

5
c
c**
40
c
c**

52
50

do 5 j=1,n-1u(j,j)=abs(p(j,j))u(j,j)=sqrt(u(j,j))al=1./u(j,j)
do 5 k=n,j+1,-1u(k,j)=al*p(k,j)
be=u(k,j)
do 5 i=k,np(i,k)=p(i,k)-u(i,j)*beu(n,n)=abs(p(n,n))u(n,n)=sqrt(u(n,n))b = transpose of u
do 40 i=1,ndo 40 j=i,nb(i,j)=u(j,i)
compute inverse of b(i,j)
binv(1,1)=1./b(1,1)
do 50 j=2,nbinv(j,j)=1./b(j,j)
jm1=j-1
do 50 k=1,jm1
sum=0.0
do 52 i=k,jm1
sum = sum - binv(k,i)*b(i,j)
binv(k,j)=sum*binv(j,j)
returnendcc********************************************************************
subroutine sqcov(n1,n,m1,md,x,cov)c**compute covariance matrix
dimension x(m1,n1),cov(n1,n1)
do 10 i=1,ndo 10 j=1,is=0.
do 12 k=1,md12
s=s+x(k,i)*x(k,j)
10
cov(i,j)=s
returnendcc********************************************************************
subroutine accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5)ccommon/st1/r(200),q0(200),qc(200),er(200),qc1(200),qc2(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,area
ページ(12)

10program.for.txt
common/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st5/sum,skai2cqsotai=0.0
qsotai2=0.0
qsotai3=0.0
sum=0.0
skai2=0.0
qmaxo=-999.99
qmaxc=-999.99
do 502 i=1,nqif(q0(i).gt.qmaxo) qmaxo=q0(i)if(qc(i).gt.qmaxc) qmaxc=qc(i)502 continue
qmax=qmaxo*area/3.6
qqmax=qmaxc*area/3.6
iko=0.0
do 501 i=1,nq
err=q0(i)-qc(i)if(q0(i).lt.0.04) go to 500
iko=iko+1
qsotai=qsotai+abs(err)/q0(i)qsotai2=qsotai2+(err/q0(i))**2
500 continue
sum=sum+err**2
skai2=skai2+(err**2)/q0(i)qsotai3=qsotai3+(err/qmaxo)**2
501 continue
xiko=ikohiryu=qmax/area
peakg=abs(qmaxo-qmaxc)/qmaxo
qsotai=qsotai/xikoqsotai2=qsotai2/xiko
sum=sqrt(sum/xnq)
skai2=skai2/xnq
qsotai3=qsotai3/xnq
qsotai4=(qtot-qctot)/qtot
qsotai5=(qmaxo-qmaxc)/qmaxo
returnend!観測ピーク!計算ピーク!誤差項!比流量!Jpe（ピーク相対誤差）!Jre（ハイドログラフ相対誤差）
!Ew
!rmse
!kai2
!E
!Ev
!Ep

c

ページ(13)

input.txt
1
湧別川
湧別川
丸瀬布
平成13年9月11日
802.0
1
2
3
10
75.8
10.0000.150
144 144
0.00
0.00
0.00
0.00
0.00
2.12
3.05
3.09
5.18
5.38
5.90
1.36
1.10
1.27
1.16
0.65
0.36
0.68
1.00
0.71
0.10
0.07
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
9.40
9.40
9.09
9.09
9.09
12.43
16.30
18.86
275.79287.79 305.39
554.89609.12 621.79
473.50462.21 442.24
333.57325.99 322.23
251.65258.31 233.77
202.94194.12 197.04
162.12164.79 156.84

200.0010

1.500
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.10

0.34

0.00

0.65

4.07

3.45

4.05

8.10

7.51

6.38

6.20

4.50

5.09

5.77

4.86

3.43

4.00

4.82

6.89

6.55

6.39

2.16

2.43

3.00

1.36

2.70

1.95

1.00

1.10

0.65

1.19

1.55

0.95

1.16

1.36

0.65

0.16

0.00

0.71

0.00

0.20

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
9.40

0.00
9.09

9.09

9.09

9.09

9.09

9.09

8.78

8.78

9.09

9.09

9.40

9.72

10.69

43.45

66.84

102.36149.14203.24233.43259.08336.51

371.10413.59441.05456.20480.53510.10645.81627.38609.21588.78553.86524.78503.48416.29403.62391.13374.80360.79345.10337.39311.09294.74289.39273.63277.10271.91265.07225.86224.29211.96202.94207.43197.04199.98194.12189.78188.35178.45177.06171.55163.45150.38155.54151.66145.30152.95142.80141.55

ページ(1)

input.txt
142.80134.20107.83104.61
89.21
88.23
73.51
71.46
59.64
59.64

129.41130.60125.87

124.70120.08111.11115.55111.11102.48102.48101.43

98.30

97.27

95.22

93.19

90.20

85.31

82.44

80.56

80.56

78.69

79.62

78.69

75.94

71.46

70.58

68.84

67.98

67.98

66.27

65.42

61.27

58.84

58.84

57.25

ページ(2)

11-1program.for.txt
c ********************************************************
c 第11回ゼミc
全流出量の感度係数を用いたc
2段タンク型貯留関数モデルの最適化
c
地下水流出成分を含む貯留関数法
c(2段タンク型非線形貯留関数モデル) のパラメータ同定
cc 作成者 星 清、東海林 勉
作成日 2005.4.1
c ********************************************************cc***
全流出量の感度係数を用いる***
c***[表面・中間流出成分(非線形)＋地下水流出成分(線形)]***c***に関して定数最適化***c***
モデル定数 c11, c12及びc13の同時最適化***
cc
一階ニュートン法（newton method）c
ヤコビアン(jacobian)行列（一次微係数使用）
c*********************************************************c***surface-subsurface runoff componentcs1 = k11*q1**p1 + k12*d(q1**p2)/dtc
ds1/dt = r-q1-bcq1 = surface-subsurface runoff componentcb = k13*q1 (b = 地下水成分への浸透供給量)ck11 = c11*A**(0.24)ck12 = c12*k11**2*(rave)**(-0.2648)cc13 = 1 + k13cp1 = 0.6 and p2 = 0.4648
cc***groundwater flow componentcs2 = k21*q2 + k22*d(q2)/dtc
ds2/dt = b - q2cq2 = groundwater flow componentck21 = c1*k22c
k22 = k13/c0cc0 = (delta/tc)**2c
c1 = delta**2/tccc***q = q1 + q2 (total runoff)ccdelta(δ) = 減衰係数（非振動解条件）cδ= 2.1 を使用
c
tc = 地下水成分分離時定数ctc : ハイドログラフ低減部の減衰係数(λ：ramda)の逆数
cc***
入力条件 ；r= 観測雨量 ；q= 観測流量cc***********************************************************
coptimization of parameters c11, c12 and c13
c***********************************************************c--------------------------------------------------------character kouzui*128,suikei*128,kasen*128&,chiten*128cdimension q(200),pas(200,9),dpa(9),co(9)dimension x(9),u(18),z(9)dimension qc1(200),qc2(200)ccommon/st1/r(200),q0(200),qc(200),er(200)
ページ(1)

11-1program.for.txt
common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st4/wk21,wk22,c00,c01ccopen(1,file='input.dat',status='unknown')
open(5,file='2dan-1new.out',status='unknown')ccp1=0.6 p2=0.4648 delta=2.1
data wp1,zp2,delta/0.6,0.4648,2.1/

cc

cc

write(5,*)'地下水流出成分を含む貯留関数法'
write(5,*)'全流出量の感度係数を用いた'
write(5,*)'2段タンク型非線形貯留関数モデルの最適化'
write(5,*)'一階ニュートン法(一次微係数使用)'
write(5,*)'モデル定数 c11, c12及びc13の同時最適化'
write(5,'()')
ncase:計算洪水数
read(1,*) ncase
write(5,'(''計算洪水数：'',i3)') ncase
write(5,'()')

cdo 9999 kk=1,ncasecread(1,3) suikei !水系名read(1,3) kasen !河川名read(1,3) chiten !観測所名read(1,3) kouzui !洪水名
c
cc
c
c
c
c
c
cc
cc

cc

area：流域面積
ipas：計算の実行判別(1:計算する 0:計算しない)
n:微分方程式の階数(n=2) m:モデル定数の個数(m=3) nl:分割数(nl=10)
kount:最大繰り返し回数(20) p:収束条件(p=0.001)
read(1,'(f8.0,i5)') area,ipas
read(1,4) n,m,nl,kount,ptc：流出成分分離時定数（ハイドログラフ低減部の減衰係数(ram)の逆数）
read(1,'(f8.0)') tc
初期値：c11,c12,c13
read(1,5) cc1,cc2,cc3
nr:雨量データ数 nq:流量データ数
read(1,'(2i5)') nr,nq
実測雨量データ入力
do i=1,nqr(i)=0.0
end doread(1,2) (r(i) ,i=1,nr)
実測流量データ入力(m3/s)
read(1,2) (q(i),i=1,nq)cc

流出高（mm/h）に変換
do 1001 i=1,nq
1001 q0(i)=3.6*q(i)/areacif(ipas.eq.0) go to 9999ccrave = 平均雨量強度
nzero=0
rtot=0.0
ページ(2)

11-1program.for.txt
do 199 i=1,nr
if(r(i).eq.0.0) go to 199
nzero=nzero+1
rtot=rtot+r(i)199 continue
xnz=nzerorave=rtot/xnz
cc基準化パラメータ
yc1=1.0
yc2=1.0
yc3=1.0cco(1)=cc1
co(2)=cc2
co(3)=cc3c
1 format(4i8,4f8.0)
2 format(10f8.0)
3 format(a128)
4 format(4i5,2f8.0)
5 format(3f8.0)
cwrite(5,'(''水系：'',a80)') suikei!水系
write(5,'(''河川名：'',a80)') kasen!河川名write(5,'(''観測地点：'',a80)') chiten!観測地点
write(5,'(''洪水年月日：'',a80)') kouzui!洪水年月日write(5,'()')
write(5,'('' 流量データ数=''i3,'' 計算時間間隔=1/'',i2)') nq,nlwrite(5,'()')
write(5,'(''分離時定数(Tc) ='',f8.2)') tc
write(5,'()')
write(5,210)
210 format('
流域面積',' 平均雨量強度',' c11初期値',' c12初期値',& 'c13初期値')
write(5,'(2f10.2,3f13.3)') area,rave,cc1,cc2,cc3c
xnl=nlh=1./xnl
h2=h**2h3=h2*hh4=h3*hm1=m+1m2=2*mxnq=nqcc
地下水流出成分の定数決定cc0,c1の計算
cc00=(delta/tc)**2
c01=delta**2/tccwrite(5,'()')
write(5,'()')
write(5,*)'
No
c11
c12
c13
rmse
kai2'
c
c
最適化開始 (一階ニュートン法)cfac=0.0
ページ(3)

11-1program.for.txt
wp2=1./zp2
do 999 kkll=1,kountcc***
モデル定数の更新
c 表面・中間流出成分(1段目タンク)の貯留係数
wk1=cc1*yc1*area**0.24
zk2=cc2*yc2*wk1**2*rave**(-0.2648)
wk2=1./zk2
wc3=cc3*yc3cc
地下水流出成分(2段目タンク)の貯留係数
zk22=(wc3-1.0)/c00
wk22=1.0/zk22
wk21=c01*zk22c 流量と感度係数の初期値設定
do 800 i=1,2*n800x(i)=0.0x(1)=q0(1)**zp2
do 802 i=1,2*m2
802u(i)=0.0c
sum=0.0
skai2=0.0c
do 30 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ll)qq=q0(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)do 40 k=1,nlc**solution of sensitivity equation
call tanksto2(x,u,1)c**solution of differential equation
call tanksto2(x,u,2)
if(x(1).le.0.0) x(1)=0.0
if(x(3).le.0.0) x(3)=0.040
continuecc 表面・中間流出成分
qc1(ll)=0.0
if(x(1).gt.0.0) qc1(ll)=x(1)**wp2c
地下水流出成分qc2(ll)=x(3)c
全流出高(計算流出高)
qcc=qc1(ll)+qc2(ll)qc(ll)=qcc
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)c
誤差項
err=qq-qcc
er(ll)=err
if(qq.eq.0.0) go to 49
erw=err/qs
skai2=skai2+erw**2
49 continue
sum=sum+err**2c
ページ(4)

c**c
c

11-1program.for.txt
sensitivity coefficients of total runoff depth
in terms of c11,c12 and c13
pas(ll,1)=(cc*u(1)+u(7))*area**0.24!c11に関する感度係数
pas(ll,2)=(cc*u(2)+u(8))*wk1**2*rave**(-0.2648) !c12に関する感度係数
pas(ll,3)=cc*u(3)+u(9)!c13に関する感度係数cccsensitivity coefficients of normalized parameters
規準化感度係数の計算
do 43 i=1,m43
pas(ll,i)=co(i)*pas(ll,i)cc**error between observed and computed dischargespas(ll,m1)=err
30
continuecskai2=skai2/xnq!kai2
sum=sqrt(sum/xnq)!rmsecwrite(5,779) kkll,cc1*yc1,cc2*yc2,cc3*yc3,sum,skai2779 format(1h ,i5,5f8.3)cz(1)=yc1z(2)=yc2z(3)=yc3c**component regression methodc**to solve the correction terms of parameters(dpa)call momreg(9,m1,200,nq,pas,dpa)
do 875 i=1,m
col = abs(dpa(i)/z(i))
if(col.gt.p) go to 877
875
continue
go to 879
877
fac = 0.5*(1.+fac)
do 878 i=1,mdpa(i)=fac*dpa(i)878continue
do 991 i=1,mxnew=z(i)+dpa(i)if(xnew.gt.0.0) z(i)=z(i)+dpa(i)991continue
yc1=z(1)yc2=z(2)yc3=z(3)999
continue879
continuecqtot=0.0
qctot=0.0
do 1002 i=1,nq
c** total observed runoff depth
qtot=qtot+q0(i)!総実測流出高
c** total computed runoff depth
qctot=qctot+qc(i)!総計算流出高
1002 continueccall accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5) !精度評価指標
ページ(5)

11-1program.for.txt
cc--OUTPUT 2
write(5,'()')
write(5,211)
211 format(3x,'収束回数',4x,'c11',9x,'c12',9x,'c13',&8x,'rmse',8x,'kai2',9x,'Jpe',9x,'Jre')write(5,'(i7,8f12.3)') kkll,cc1*yc1,cc2*yc2,cc3*yc3,&sum,skai2,peakg,qsotai
write(5,'()')
write(5,214)
214 format(5x,'Ew',9x,'E',9x,'Ev',8x,'Ep')
write(5,'(4f10.3)')qsotai2,qsotai3,qsotai4,qsotai5
write(5,'()')
write(5,212)
212 format(4x,'比流量',3x,'総雨量',4x,'観測総流出',3x,'計算総流出',3x,&'観測ピーク値',3x,'計算ピーク値')
write(5,'(3f10.3,f12.3,2f16.3)') hiryu,rtot,qtot,qctot,qmax,qqmax
write(5,'()')
write(5,'()')
write(5,204)
204 format(7x,'NO',6x,'実測雨量',7x,'実測流出高',& 3x,'計算表面中間流出',3x,'浸透供給高',3x,&'計算地下水',2x,'計算全流出高<表中+地下>')cdo i=1,nq
write(5,207) i,r(i),q0(i),qc1(i),qc1(i)*(wc3-1.0),& qc2(i),qc(i)end do207 format(i8,f12.2,4f16.4,f19.4,3f16.4)
c9999 continue
c
stop
end
c
c---------------------------------------------subroutine accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5)ccommon/st1/r(200),q0(200),qc(200),er(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rainqsotai=0.0
qsotai2=0.0
qsotai3=0.0
qmaxo=-999.99
qmaxc=-999.99
do 502 i=1,nqif(q0(i).gt.qmaxo) qmaxo=q0(i)!観測ピークif(qc(i).gt.qmaxc) qmaxc=qc(i)!計算ピーク502 continue
qmax=qmaxo*area/3.6
qqmax=qmaxc*area/3.6
iko=0.0
do 501 i=1,nqif(q0(i).lt.0.04) go to 500
iko=iko+1
qsotai=qsotai+abs(q0(i)-qc(i))/q0(i)ページ(6)

11-1program.for.txt
qsotai2=qsotai2+((q0(i)-qc(i))/q0(i))**2
500 continue
qsotai3=qsotai3+((q0(i)-qc(i))/qmaxo)**2
501 continue
xiko=ikohiryu=qmax/area!比流量peakg=abs(qmaxo-qmaxc)/qmaxo!Jpe（ピーク相対誤差）
qsotai=qsotai/xiko!Jre（ハイドログラフ相対誤差）
qsotai2=qsotai2/xiko!Ewqsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmaxo-qmaxc)/qmaxo!Ep
returnendcc---------------------------------------------subroutine tanksto2(x,u,ijk)cc*************************************************************c
地下水流出成分を含む貯留関数法
c(2段タンク型非線形貯留関数モデル) のパラメータ同定cc
一階ニュートン法（newton method）c
ヤコビアン(jacobian)行列（一次微係数使用）
c*************************************************************c**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18),b(9)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st4/wk21,wk22,c00,c01ccon=wk1*wk2*wp1*wp2
wk13=wc3-1.0
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)y3=x(3)y4=x(4)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 1412
a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2c
1段目タンクの係数
14a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c*wc3
a2=-con*da3=a1+a2**2
a4=a1+a3c
２段目タンクの係数
a5=-c00/wk13
ページ(7)

c**
c

c**
c
c

c

11-1program.for.txt
a6=-c01
a7=a5+a6**2
a8=a5+a7
elements of phi matrix (transition matrix)
1段目タンクのΦの値
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
elements of gamma matrix
1段目タンクのγの値
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
２段目タンクのΦの値
f5 = 1. +0.5*a5*h2+a5*a6*h3/6.+a5*a7*h4/24.
f6 = h*(1. + 0.5*a6*h+a7*h2/6.+a6*a8*h3/24.)
f7 = a5*f6
f8 = 1. +a6*h+0.5*a7*h2+a6*a8*h3/6.+&(a5*a7+a6**2*a8)*h4/24.
２段タンク目のγの値
g6 = h2*(0.5+a6*h/6.+a7*h2/24.)
g8=f6

cif(ijk.eq.2) go to 104
c
c**
c**
c

solve sensitivity equation
1段目タンクにおける感度係数の計算
感度方程式の強制項計算b(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e*wc3 - rain)b(3)=-wk2*e
do 16 i=1,m
16
uu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
18
uu(i) = f3*u(i-m) + f4*u(i) + g4*b(i-m)
c**
２段目タンクにおける感度係数の計算
c
感度方程式の強制項計算
m3=m2+mb(4)=c00*wp2*c*u(1)b(5)=c00*wp2*c*u(2)b(6)=c00*wp2*c*u(3)+(c00/wk13**2)*y3
do 17 i=1,m
17 uu(i+m2)= f5*u(i+m2) + f6*u(i+m3) + g6*b(i+m)
do 19 i=m1,m2
19 uu(i+m2) = f7*u(i+m) + f8*u(i+m2) + g8*b(i)do 20 i=1,2*m220u(i)=uu(i)returnc
104
continuec**solve system equationc**
1段目タンクの状態変量(y1,y2)の計算
b1=con*(wp1*wp2-1.)*d*y2+wk2*wc3*(wp2-1.)*e+wk2*rainy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
c**
２段目タンクの状態変量(y3,y4)の計算
b2=c00*e
ページ(8)

102

11-1program.for.txt
y(3) = f5*x(3)+f6*x(4)+g6*b2
y(4) = f7*x(3)+f8*x(4)+g8*b2
do 102 i=1,2*nx(i)=y(i)returnendcc---------------------------------------------subroutine momreg(n1,n,m1,md,x,dpa)
c**component regression methodc**compute the correction terms of parameters (dpa)cimplicit double precision (a-h,o-z)
dimension x(m1,n1),dpa(1),cov(9,9),g(200,9),y(200,9)
dimension binv(9,9),coe(9),st(9)cna=n-1c**compute covariance matrix
call sqcov(n1,na,m1,md,x,cov)
do 50 i=1,na50
st(i)=sqrt(cov(i,i))
do 52 i=1,na
s=st(i)do 52 j=1,i
s1=st(j)cov(i,j)=cov(i,j)/(s*s1)
52
cov(j,i)=cov(i,j)
c**factorization of cov(i,j) by lower triangularc**cholesky method (cov = l * u)c**l = lower triangular u = upper triangularc**compute the inverse of u(i,j)
call lowtri(n1,na,cov,binv)
do 54 j=1,na
s=st(j)do 54 i=1,md
54
y(i,j)=x(i,j)/s
do 20 i=1,md
do 20 j=1,na
s=0.
do 22 k=1,j22
s=s+y(i,k)*binv(k,j)
20
g(i,j)=s
do 24 i=1,na
s=0.0
do 26 j=1,md
26
s=s+g(j,i)*x(j,n)
24coe(i)=s
do 30 i=1,na
s=0.
do 29 j=i,na29
s=s+binv(i,j)*coe(j)30dpa(i)=s/st(i)returnendcc---------------------------------------------subroutine lowtri(n1,n,p,binv)c**lower triangular cholesky factorizationc**p = u*bページ(9)

c**
c**
c**
c**
c**
c**
c
c

11-1program.for.txt
p = symmetric matrix
u = lower triangular matrixb = upper triangular matrix (b = ut)
binv = inverse matrix of b
= upper triangular matrix
compute lower triangular u(i,j)
implicit double precision (a-h,o-z)
dimension p(n1,n1),binv(n1,n1)
dimension u(9,9),b(9,9)

c

5
c
c**
40
c
c**

52
50

do 5 j=1,n-1u(j,j)=abs(p(j,j))u(j,j)=sqrt(u(j,j))al=1./u(j,j)
do 5 k=n,j+1,-1u(k,j)=al*p(k,j)
be=u(k,j)
do 5 i=k,np(i,k)=p(i,k)-u(i,j)*beu(n,n)=abs(p(n,n))u(n,n)=sqrt(u(n,n))b = transpose of u
do 40 i=1,ndo 40 j=i,nb(i,j)=u(j,i)
compute inverse of b(i,j)
binv(1,1)=1./b(1,1)
do 50 j=2,nbinv(j,j)=1./b(j,j)
jm1=j-1
do 50 k=1,jm1
sum=0.0
do 52 i=k,jm1
sum = sum - binv(k,i)*b(i,j)
binv(k,j)=sum*binv(j,j)
returnendcc---------------------------------------------subroutine sqcov(n1,n,m1,md,x,cov)c**compute covariance matrixc
implicit double precision (a-h,o-z)
dimension x(m1,n1),cov(n1,n1)
do 10 i=1,ndo 10 j=1,is=0.
do 12 k=1,md12
s=s+x(k,i)*x(k,j)
10
cov(i,j)=s
returnendcc

ページ(10)input.txt
1
湧別川
湧別川
丸瀬布
平成13年9月11日
802.0
1
2
3
10
75.8
9.000
0.150
144 144
0.00
0.00
0.00
0.00
0.00
2.12
3.05
3.09
5.18
5.38
5.90
1.36
1.10
1.27
1.16
0.65
0.36
0.68
1.00
0.71
0.10
0.07
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
9.40
9.40
9.09
9.09
9.09
12.43
16.30
18.86
275.79287.79 305.39
554.89609.12 621.79
473.50462.21 442.24
333.57325.99 322.23
251.65258.31 233.77
202.94194.12 197.04
162.12164.79 156.84

200.0010

1.500
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.10

0.34

0.00

0.65

4.07

3.45

4.05

8.10

7.51

6.38

6.20

4.50

5.09

5.77

4.86

3.43

4.00

4.82

6.89

6.55

6.39

2.16

2.43

3.00

1.36

2.70

1.95

1.00

1.10

0.65

1.19

1.55

0.95

1.16

1.36

0.65

0.16

0.00

0.71

0.00

0.20

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
9.40

0.00
9.09

9.09

9.09

9.09

9.09

9.09

8.78

8.78

9.09

9.09

9.40

9.72

10.69

43.45

66.84

102.36149.14203.24233.43259.08336.51

371.10413.59441.05456.20480.53510.10645.81627.38609.21588.78553.86524.78503.48416.29403.62391.13374.80360.79345.10337.39311.09294.74289.39273.63277.10271.91265.07225.86224.29211.96202.94207.43197.04199.98194.12189.78188.35178.45177.06171.55163.45150.38155.54151.66145.30152.95142.80141.55

ページ(1)

input.txt
142.80134.20107.83104.61
89.21
88.23
73.51
71.46
59.64
59.64

129.41130.60125.87

124.70120.08111.11115.55111.11102.48102.48101.43

98.30

97.27

95.22

93.19

90.20

85.31

82.44

80.56

80.56

78.69

79.62

78.69

75.94

71.46

70.58

68.84

67.98

67.98

66.27

65.42

61.27

58.84

58.84

57.25

ページ(2)

11-2program.for.txt
c ********************************************************
c 第11回ゼミc
全流出量の感度係数を用いたc
2段タンク型貯留関数モデルの最適化
c
地下水流出成分を含む貯留関数法
c(2段タンク型非線形貯留関数モデル) のパラメータ同定
cc 作成者 星 清、宮武 真由子
作成日 2005.6.13
c ********************************************************cc***
全流出量の感度係数を用いる***
c***[表面・中間流出成分(非線形)＋地下水流出成分(線形)]***c***に関して定数最適化***c***
モデル定数 c11, c12及びc13の同時最適化***cc
ダビドン(davidon)法c
ヤコビアン(jacobian)行列（一次微係数）c
ヘイシアン(hessian)行列（二次微係数）
c*********************************************************c***surface-subsurface runoff componentcs1 = k11*q1**p1 + k12*d(q1**p2)/dtc
ds1/dt = r-q1-bcq1 = surface-subsurface runoff componentcb = k13*q1 (b = 地下水成分への浸透供給量)ck11 = c11*A**(0.24)ck12 = c12*k11**2*(rave)**(-0.2648)cc13 = 1 + k13cp1 = 0.6 and p2 = 0.4648
cc***groundwater flow componentcs2 = k21*q2 + k22*d(q2)/dtc
ds2/dt = b - q2cq2 = groundwater flow componentck21 = c1*k22c
k22 = k13/c0cc0 = (delta/tc)**2c
c1 = delta**2/tccc***q = q1 + q2 (total runoff)cdelta(δ) = 減衰係数（非振動解条件）cδ= 2.1 を使用
c
tc = 地下水成分分離時定数ctc : ハイドログラフ低減部の減衰係数(λ：ramda)の逆数
cc***
入力条件 ；r= 観測雨量 ；q= 観測流量cc************************************************
coptimization of parameters c11, c12 and c13ccharacter kouzui*128,suikei*128,kasen*128&,chiten*128cdimension q(200)dimension z(9)dimension ddi(3),ho(3,3),djo(3),djo2(3,3),dpa(3)ccommon/st1/r(200),q0(200),qc(200),er(200),qc1(200),qc2(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,area
ページ(1)

11-2program.for.txt
common/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st4/wk21,wk22,c00,c01
common/st5/sum,skai2,co(3),beta(3)copen(1,file='input.dat',status='unknown')
open(6,file='2dan-davi.out',status='unknown')ccp1=0.6 p2=0.4648 delta=2.1
wp1=0.6
zp2=0.4648
delta=2.1

cc

cc

write(6,*)'地下水流出成分を含む貯留関数法'
write(6,*)'全流出量の感度係数を用いた'
write(6,*)'2段タンク型非線形貯留関数モデルの最適化'
write(6,*)'ダビドン法（一次・二次感度係数使用)'
write(6,*)'モデル定数 c11, c12及びc13の同時最適化'
write(6,'()')
ncase:計算洪水数
read(1,*) ncase
write(6,'(''計算洪水数：'',i3)') ncase
write(6,'()')

cdo 9999 kk=1,ncasecread(1,3) suikei !水系名read(1,3) kasen !河川名read(1,3) chiten !観測所名read(1,3) kouzui !洪水名
c
cc
c
c
c
c
c
cc
cc

cc

area：流域面積
ipas：計算の実行判別(1:計算する 0:計算しない)
n:微分方程式の階数(n=2) m:モデル定数の個数(m=3) nl:分割数(nl=10)
kount:最大繰り返し回数(20) p:収束条件(p=0.001)
read(1,'(f8.0,i5)') area,ipas
read(1,4) n,m,nl,kount,ptc：流出成分分離時定数（ハイドログラフ低減部の減衰係数(ram)の逆数）
read(1,'(f8.0)') tc
初期値：c11,c12,c13
read(1,5) cc1,cc2,cc3
nr:雨量データ数 nq:流量データ数
read(1,'(2i5)') nr,nq
実測雨量データ入力
do i=1,nqr(i)=0.0
end doread(1,2) (r(i) ,i=1,nr)
実測流量データ入力(m3/s)
read(1,2) (q(i),i=1,nq)cc

流出高（mm/h）に変換
do 1001 i=1,nq
1001 q0(i)=3.6*q(i)/areacif(ipas.eq.0) go to 9999ccrave = 平均雨量強度
nzero=0
ページ(2)

11-2program.for.txt
rtot=0.0
do 199 i=1,nr
if(r(i).eq.0.0) go to 199
nzero=nzero+1
rtot=rtot+r(i)199 continue
xnz=nzerorave=rtot/xnz
cc基準化パラメータ
yc1=1.0
yc2=1.0
yc3=1.0cco(1)=cc1
co(2)=cc2
co(3)=cc3c
1 format(4i8,4f8.0)
2 format(10f8.0)
3 format(a128)
4 format(4i5,2f8.0)
5 format(3f8.0)
cwrite(6,'(''水系：'',a80)') suikei!水系
write(6,'(''河川名：'',a80)') kasen!河川名write(6,'(''観測地点：'',a80)') chiten!観測地点
write(6,'(''洪水年月日：'',a80)') kouzui!洪水年月日write(6,'()')
write(6,'('' 流量データ数 =''i3,'' 計算時間間隔 =1/'',i2)') nq,nlwrite(6,'()')
write(6,'(''分離時定数(Tc) ='',f8.2)') tc
write(6,'()')
write(6,210)
210 format('
流域面積',' 平均雨量強度',' c11初期値',' c12初期値',& 'c13初期値')
write(6,'(2f10.2,3f13.3)') area,rave,cc1,cc2,cc3c
xnl=nlh=1./xnl
h2=h**2h3=h2*hh4=h3*hm1=m+1m2=2*mxnq=nqcc
地下水流出成分の定数決定cc0,c1の計算
cc00=(delta/tc)**2
c01=delta**2/tccwrite(6,'()')
write(6,'()')
write(6,*)'
No
c11
c12
c13
rmse
kai2'
c
fac=0.0
wp2=1./zp2
ページ(3)

11-2program.for.txt
beta(1)=area**0.24
beta(3)=1.0
c
c***
c

最適化開始 (davidon法) ***do 999 kkll=1,kountcc*** モデル定数の更新c
表面・中間流出成分(1段目タンク)の貯留係数
wk1=cc1*yc1*area**0.24
zk2=cc2*yc2*wk1**2*rave**(-0.2648)
beta(2)=wk1**2*rave**(-0.2648)
wk2=1./zk2
wc3=cc3*yc3cc
地下水流出成分(2段目タンク)の貯留係数
zk22=(wc3-1.0)/c00
wk22=1.0/zk22
wk21=c01*zk22
ccall davidon6(djo,djo2,ho)ccdjo: jacobian matrix of objective functioncdjo2: hessian matrix of objective functioncho: inverse mmatrix of djo2
cwrite(6,779) kkll,cc1*yc1,cc2*yc2,cc3*yc3,sum,skai2779 format(1h ,i5,5f8.3)cz(1)=yc1z(2)=yc2z(3)=yc3cc**solve the correction terms of parameters
do 932 i=1,mddi(i)=0.0
do 934 j=1,m
934 ddi(i)=ddi(i)+ho(i,j)*djo(j)dpa(i)=-ddi(i)932 continuecdo 875 i=1,m
col = abs(dpa(i)/z(i))
if(col.gt.p) go to 877
875
continue
go to 879
877
fac = 0.5*(1.+fac)
do 878 i=1,mdpa(i)=fac*dpa(i)878continue
do 991 i=1,mxnew=z(i)+dpa(i)if(xnew.gt.0.0) z(i)=z(i)+dpa(i)991continue
yc1=z(1)yc2=z(2)yc3=z(3)999
continue
ページ(4)

11-2program.for.txt879ccontinue

qtot=0.0
qctot=0.0
do 1002 i=1,nq
c** total observed runoff depth
qtot=qtot+q0(i)!総実測流出高
c** total computed runoff depth
qctot=qctot+qc(i)!総計算流出高
1002 continueccall accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5) !精度評価指標cc--OUTPUT 2
write(6,'()')
write(6,211)
211 format(3x,'収束回数',4x,'c11',9x,'c12',9x,'c13',&8x,'rmse',8x,'kai2',9x,'Jpe',9x,'Jre')write(6,'(i7,8f12.3)') kkll,cc1*yc1,cc2*yc2,cc3*yc3,&sum,skai2,peakg,qsotai
write(6,'()')
write(6,214)
214 format(5x,'Ew',9x,'E',9x,'Ev',8x,'Ep')
write(6,'(4f10.3)') qsotai2,qsotai3,qsotai4,qsotai5
write(6,'()')
write(6,212)
212 format(4x,'比流量',3x,'総雨量',4x,'観測総流出',3x,'計算総流出',3x,& '観測ピーク値',3x,'計算ピーク値')
write(6,'(3f10.3,f12.3,2f16.3,i14)') hiryu,rtot,qtot,qctot,qmax,& qqmax
write(6,'()')
write(6,'()')
write(6,204)
204 format(7x,'NO',6x,'実測雨量',7x,'実測流出高',& 3x,'計算表面中間流出',3x,'浸透供給高',3x,&'計算地下水',2x,'計算全流出高<表中+地下>')cdo i=1,nq
write(6,207) i,r(i),q0(i),qc1(i),qc1(i)*(wc3-1.0),& qc2(i),qc(i)end do207 format(i8,f12.2,4f16.4,f19.4,3f16.4)
c9999 continue
c
stop
end
c
c-----------------------------------------------subroutine davidon6(djp,dj2,pin)
c******************************************************c
地下水流出成分を含む貯留関数法
c(2段タンク型非線形貯留関数モデル) のパラメータ同定
ccccc
全流出量の感度係数を用いたc
2段タンク型非線形貯留関数モデルの最適化
c(表面・中間流出成分＋地下水流出成分)
ページ(5)

11-2program.for.txt
ccccc
ダビドン法（davidon method）c
ヤコビアン(jacobian)行列（一次微係数使用）c
ヘイシアン(hessian)行列（二次微係数）
c*******************************************************cfirst and second derivatives of objective function incterms of parametersccompute the hessian matrix of objective function (dj2)cand its inverse matrix (pin)cdimension x(4),u(12)dimension pax(3),uq2(3,3),ho(3,3),djp(3),dj2(3,3),pp(3,3)
dimension u1(3,3),u2(3,3),u3(3,3),u4(3,3),pin(3,3)
ccommon/st1/r(200),q0(200),qc(200),er(200),qc1(200),qc2(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st4/wk21,wk22,c00,c01
common/st5/sum,skai2,co(3),beta(3)cdo 900 i=1,m
djp(i)=0.0
do 902 j=i,mho(i,j)=0.0
902 continue
900 continuecc
流量と感度係数の初期値設定
do 800 i=1,2*n
800 x(i)=0.0
x(1)=q0(1)**zp2
do 802 i=1,2*m2
802 u(i)=0.0c
二次感度係数の初期値設定
do 804 i=1,m
do 804 j=i,mu1(i,j)=0.0
u2(i,j)=0.0
u3(i,j)=0.0
u4(i,j)=0.0
804 continuecsum=0.0
skai2=0.0c
do 30 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ll)qq=q0(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)do 40 k=1,nlc**solution of sensitivity equationccall tanksto3(x,u,u1,u2,u3,u4,1)cc**solution of differential equationc
ページ(6)

11-2program.for.txt
call tanksto3(x,u,u1,u2,u3,u4,2)cif(x(1).le.0.0) x(1)=0.0
if(x(3).le.0.0) x(3)=0.0
40 continue
c
c
c
c

c

表面・中間流出成分
qc1(ll)=0.0
if(x(1).gt.0.0) qc1(ll)=x(1)**wp2
地下水流出成分qc2(ll)=0.0
if(x(3).gt.0.0) qc2(ll)=x(3)
全流出高(計算流出高)
qcc=qc1(ll)+qc2(ll)qc(ll)=qcc
cc=0.0dd1=0.0
if(x(1).le.0.0) go to 41
cc=wp2*x(1)**(wp2-1.)
dd1=wp2*(wp2-1.)*x(1)**(wp2-2.)
41 continue
誤差項
err=qq-qcc
er(ll)=err
if(qq.eq.0.0) go to 49
erw=err/qs
skai2=skai2+erw**2
49 continue
sum=sum+err**2ccc

一次微係数の算定
first sensitivity coefficients in terms of k11,k12 and c13
do 910 i=1,m
910 pax(i)=cc*u(i)+u(i+m2)cfirst sensitivity coefficients in terms of c11,c12 and c13
do 908 i=1,m908 pax(i)=beta(i)*pax(i)cc
二次微係数の算定
csecond sensitivity coefficients in terms of k11,k12 and c13
do 911 i=1,m
do 911 j=i,muq2(i,j)=cc*u1(i,j)+dd1*u(i)*u(j)+u3(i,j)
911 continuecsecond sensitivity coefficients in terms of c11,c12 and c13
do 915 i=1,m
do 915 j=i,muq2(i,j)=beta(i)*beta(j)*uq2(i,j)
915 continuechessian matrix [G]do 912 i=1,m
do 912 j=i,mho(i,j)=ho(i,j)+err*uq2(i,j)-pax(i)*pax(j)912 continuecjacobian vector [g]do 920 i=1,m
920 djp(i)=djp(i)+err*pax(i)30 continue
ページ(7)

11-2program.for.txt
c
c***
c

objective function ***skai2=skai2/xnq
sum=sqrt(sum/xnq)

!kai2
!rmse

c
c
c

jacobian matrix of objective functionin terms of standardized parameters
do 930 i=1,m
930 djp(i)=-2.*co(i)*djp(i)/xnqchessian matrix of objective function
do 932 i=1,m
do 932 j=i,mdj2(i,j)=-2.*co(i)*co(j)*ho(i,j)/xnq
932 continue
do 934 i=1,m
do 934 j=i,mdj2(j,i)=dj2(i,j)
934 continue
do 935 i=1,m
do 935 j=1,m
935 pp(i,j)=dj2(i,j)
cccompute the inverse(pin) of hessian matrix(pp)ccall inverse(m,pp,pin)creturnendcc-----------------------------------------------subroutine tanksto3(x,u,u1,u2,u3,u4,ijk)
c******************************************************c
地下水流出成分を含む貯留関数法
c(2段タンク型非線形貯留関数モデル) のパラメータ同定
ccccc
全流出量の感度係数を用いたc
2段タンク型非線形貯留関数モデルの最適化
c(表面・中間流出成分＋地下水流出成分)
ccccc
ダビドン法（davidon method）c
ヤコビアン(jacobian)行列（一次微係数使用）c
ヘイシアン(hessian)行列（二次微係数）
c******************************************************c**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equation
dimension x(4),u(12),y(4),uu(12),b(6)dimension u1(3,3),uu1(3,3),u2(3,3),uu2(3,3)
dimension u3(3,3),uu3(3,3),u4(3,3),uu4(3,3)
dimension ccc(2,2),dz(2,3),dw(3,3),ua(3,2),uat(2,3)
dimension hhz(3,3),ak(3,3),bk(3,3),db(3,2)
dimension hhz2(3,3),ck(3,3),ckt(3,3),dw2(3,3)
common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st4/wk21,wk22,c00,c01c
ページ(8)

12

c
14

c

c**
c

c**
c
c

c

11-2program.for.txt
con=wk1*wk2*wp1*wp2
wk13=wc3-1.0
a=0.0
c=0.0
d=0.0
e=0.0
f=0.0
g=0.0
y1=x(1)y2=x(2)y3=x(3)y4=x(4)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
f=y1**(wp1*wp2-3.)
g=y1**(wp2-2.)
1段目タンクの係数
a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c*wc3
a2=-con*da3=a1+a2**2
a4=a1+a3
２段目タンクの係数
a5=-c00/wk13
a6=-c01
a7=a5+a6**2
a8=a5+a7
elements of phi matrix (transition matrix)
1段目タンクのΦの値
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
elements of gamma matrix
1段目タンクのγの値
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
２段目タンクのΦの値
f5 = 1. +0.5*a5*h2+a5*a6*h3/6.+a5*a7*h4/24.
f6 = h*(1. + 0.5*a6*h+a7*h2/6.+a6*a8*h3/24.)
f7 = a5*f6
f8 = 1. +a6*h+0.5*a7*h2+a6*a8*h3/6.+&(a5*a7+a6**2*a8)*h4/24.
２段タンク目のγの値
g6 = h2*(0.5+a6*h/6.+a7*h2/24.)
g8=f6

cif(ijk.eq.2) go to 104
c
c**
c**

solve sensitivity equation (first derivatives)
1段目タンクにおける一次感度係数の計算
b(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e*wc3 - rain)
ページ(9)

11-2program.for.txtb(3)=-wk2*e
do 16 i=1,m
16 uu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
18 uu(i)= f3*u(i-m) + f4*u(i) + g4*b(i-m)
c**
２段目タンクにおける一次感度係数の計算
m3=m2+mb(4)=c00*wp2*c*u(1)b(5)=c00*wp2*c*u(2)b(6)=c00*wp2*c*u(3)+(c00/wk13**2)*y3
do 17 i=1,m
17 uu(i+m2)= f5*u(i+m2) + f6*u(i+m3) + g6*b(i+m)
do 19 i=m1,m2
19 uu(i+m2)= f7*u(i+m) + f8*u(i+m2) + g8*b(i)cc**solve hessian equation(second derivatives)c
1段目タンクにおける二次感度係数の計算
cc2=wp1*wp2cc
ccc(i,j)=da1/dx (first derivatives in terms of x)c
ccc(1,1)=-con*(c2-1.)*(c2-2.)*f*y2&-wk2*wp2*wc3*(wp2-1.)*g
ccc(1,2)=-con*(c2-1.)*a
ccc(2,1)=ccc(1,2)
ccc(2,2)=0.0ccdz(i,j)=da1/dk (first derivatives in terms of k)cdz(1,1)=-wk2*c2*(c2-1.)*a*y2
dz(1,2)=wk2*con*(c2-1.)*a*y2+wk2**2*wp2*wc3*cdz(1,3)=-wk2*wp2*cdz(2,1)=-wk2*c2*ddz(2,2)=wk2*con*ddz(2,3)=0.0ccdb(i,j)=db1/dx (=transpose of dz(i,j))c
do 306 i=1,2
do 306 j=1,m
306 db(j,i)=dz(i,j)
ccdw(i,j)=db/dk (first derivatives in terms of k)cdw(1,1)=0.0dw(1,2)=wk2**2*c2*d*y2
dw(1,3)=0.0dw(2,1)=dw(1,2)
dw(2,2)=2.*wk2**3*(-wk1*c2*d*y2- e*wc3+ rain)dw(2,3)=wk2**2*edw(3,1)=dw(1,3)
dw(3,2)=dw(2,3)
dw(3,3)=0.0cc*** elements of forcing function in thecsecond sensitivity equation
ij=0
ページ(10)11-2program.for.txt
do 191 j=1,2
do 191 i=1,m
ij=ij+1
191 ua(i,j)=u(ij)ctranspose of ua
do 193 i=1,m
do 193 j=1,2
193 uat(j,i)=ua(i,j)
cc*** (dda1/ddk)=(da1/dx)*uat+(da1/dk)
c
do 202 i=1,2
do 202 j=1,m
s=0.0
do 195 k=1,2
195 s=s+ccc(i,k)*uat(k,j)
ak(i,j)=dz(i,j)+s
202 continuecc***(ddb1/ddk)=(db1/dx)*uat+(db1/dk)
c
do 204 i=1,m
do 204 j=1,m
s=0.0
do 206 k=1,2
206 s=s+db(i,k)*uat(k,j)
bk(i,j)=dw(i,j)+s
204 continuecc*** hhz(i,j)=ua*ak(i,j)+bk(i,j)
cdo 207 i=1,m
do 207 j=1,m
s=0.0
do 209 k=1,2
209 s=s+ua(i,k)*ak(k,j)
hhz(i,j)=bk(i,j)+s
207 continuecc**
1段目タンクの二次感度係数cuu1(i,j)= w11(i,j);hessian matrix in terms of x1
do 220 i=1,m
do 220 j=i,m
220 uu1(i,j)=f1*u1(i,j)+f2*u2(i,j)+g2*hhz(i,j)
ccuu2(i,j)= w12(i,j);hessian matrix in terms of x2
do 222 i=1,m
do 222 j=i,m
222 uu2(i,j)=f3*u1(i,j)+f4*u2(i,j)+g4*hhz(i,j)
ccc
2段目タンクにおける二次感度係数の計算
cdz2(i,j)=da/dk (first derivatives in terms of k)
ccc
dz2(1,3)=c00/wk13**2ccdw2(i,j)=db/dk (first derivatives in terms of k)c
cc=wp2*cページ(11)

11-2program.for.txt
dd1=wp2*(wp2-1.)*gcdo 231 i=1,m
do 231 j=i,mdw2(i,j) = c00*(dd1*u(i)*u(j)+cc*u1(i,j))dw2(j,i)=dw2(i,j)
231 continue
dw2(3,3)=dw2(3,3)-2.*c00*y3/(wk13**3)
c
c***
c

elements of forcing function in thesecond sensitivity equation
do 192 j=1,m
do 192 i=1,mck(i,j)=0.0
192 continuecc***ua2*ak(i,j)
do 194 i=1,mck(i,m)= (c00/wk13**2)*u(i+m2)
194 continuectranspose of ck (db/dx*uat)
do 198 i=1,m
do 198 j=1,m
198 ckt(j,i)=ck(i,j)
cc
c*** hhz2(i,j)=ck(i,j)+ckt(i,j)+dw2(i,j)
cdo 208 i=1,m
do 208 j=i,m
208 hhz2(i,j)=ck(i,j)+ckt(i,j)+dw2(i,j)
cc**
2段目タンクの二次感度係数cuu3(i,j)= w21(i,j);hessian matrix in terms of x3
do 226 i=1,m
do 226 j=i,m
226 uu3(i,j)=f5*u3(i,j)+f6*u4(i,j)+g6*hhz2(i,j)
cuu4(i,j)= w22(i,j);hessian matrix in terms of x4
do 228 i=1,m
do 228 j=i,m
228 uu4(i,j)=f7*u3(i,j)+f8*u4(i,j)+g8*hhz2(i,j)
cc
感度係数の更新
do 20 i=1,2*m2
20 u(i)=uu(i)do 224 i=1,m
do 224 j=i,mu1(i,j)=uu1(i,j)
u2(i,j)=uu2(i,j)
u3(i,j)=uu3(i,j)
224 u4(i,j)=uu4(i,j)
creturnc
104
continuecc**solve system equationc**
1段目タンクの状態変量(y1,y2)の計算
b1=con*(wp1*wp2-1.)*d*y2+wk2*wc3*(wp2-1.)*e+wk2*rain
ページ(12)c**102

11-2program.for.txt
y(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
２段目タンクの状態変量(y3,y4)の計算
b2=c00*ey(3) = f5*x(3)+f6*x(4)+g6*b2
y(4) = f7*x(3)+f8*x(4)+g8*b2
do 102 i=1,2*nx(i)=y(i)returnendcc-----------------------------------------------subroutine inverse(n,a,d)cccompute the inverse of definite matrixc
逆行列の算定ca=input matrixcd=inverse of matrix acdimension a(3,3),b(9),c(9),d(3,3)
do 154 i=1,ndo 151 j=1,nb(j)=a(j,i)
151 a(j,i)=0.0a(i,i)=1.0
do 152 j=1,n
152 c(j)=a(i,j)/b(i)do 153 j=1,ndo 153 k=1,n
153 a(j,k)=a(j,k)-c(k)*b(j)do 154 j=1,n
154 a(i,j)=c(j)do 156 i=1,ndo 156 j=1,n
156 d(i,j)=a(i,j)
returnendcc-----------------------------------------------subroutine accuracy(qtot,qctot,qmaxo,qmaxc,qmax,qqmax,hiryu,peakg,& qsotai,qsotai2,qsotai3,qsotai4,qsotai5)ccommon/st1/r(200),q0(200),qc(200),er(200),qc1(200),qc2(200)common/st2/n,m,m1,m2,nl,h,h2,h3,h4,areacommon/st3/nr,nq,xnq,wk1,wk2,wp1,wp2,zk2,zp2,wc3,rain
common/st5/sum,skai2,co(3),beta(3)cqsotai=0.0
qsotai2=0.0
qsotai3=0.0
sum=0.0
skai2=0.0
qmaxo=-999.99
qmaxc=-999.99
do 502 i=1,nqif(q0(i).gt.qmaxo) qmaxo=q0(i)!観測ピークif(qc(i).gt.qmaxc) qmaxc=qc(i)!計算ピーク502 continue
ページ(13)

11-2program.for.txt
qmax=qmaxo*area/3.6
qqmax=qmaxc*area/3.6
iko=0.0
do 501 i=1,nq
err=q0(i)-qc(i)!誤差項
if(q0(i).lt.0.04) go to 500
iko=iko+1
qsotai=qsotai+abs(err)/q0(i)qsotai2=qsotai2+(err/q0(i))**2
500 continue
sum=sum+err**2
skai2=skai2+(err**2)/q0(i)qsotai3=qsotai3+(err/qmaxo)**2
501 continue
xiko=ikohiryu=qmax/area!比流量peakg=abs(qmaxo-qmaxc)/qmaxo!Jpe（ピーク相対誤差）
qsotai=qsotai/xiko!Jre（ハイドログラフ相対誤差）
qsotai2=qsotai2/xiko!Ew
sum=sqrt(sum/xnq)!rmse
skai2=skai2/xnq!kai2
qsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmaxo-qmaxc)/qmaxo!Ep
returnend

ページ(14)

input.txt
1
湧別川
湧別川
丸瀬布
平成13年9月11日
802.0
1
2
3
10
75.8
9.000
0.150
144 144
0.00
0.00
0.00
0.00
0.00
2.12
3.05
3.09
5.18
5.38
5.90
1.36
1.10
1.27
1.16
0.65
0.36
0.68
1.00
0.71
0.10
0.07
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
9.40
9.40
9.09
9.09
9.09
12.43
16.30
18.86
275.79287.79 305.39
554.89609.12 621.79
473.50462.21 442.24
333.57325.99 322.23
251.65258.31 233.77
202.94194.12 197.04
162.12164.79 156.84

200.0010

1.500
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.10

0.34

0.00

0.65

4.07

3.45

4.05

8.10

7.51

6.38

6.20

4.50

5.09

5.77

4.86

3.43

4.00

4.82

6.89

6.55

6.39

2.16

2.43

3.00

1.36

2.70

1.95

1.00

1.10

0.65

1.19

1.55

0.95

1.16

1.36

0.65

0.16

0.00

0.71

0.00

0.20

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
9.40

0.00
9.09

9.09

9.09

9.09

9.09

9.09

8.78

8.78

9.09

9.09

9.40

9.72

10.69

43.45

66.84

102.36149.14203.24233.43259.08336.51

371.10413.59441.05456.20480.53510.10645.81627.38609.21588.78553.86524.78503.48416.29403.62391.13374.80360.79345.10337.39311.09294.74289.39273.63277.10271.91265.07225.86224.29211.96202.94207.43197.04199.98194.12189.78188.35178.45177.06171.55163.45150.38155.54151.66145.30152.95142.80141.55

ページ(1)

input.txt
142.80134.20107.83104.61
89.21
88.23
73.51
71.46
59.64
59.64

129.41130.60125.87

124.70120.08111.11115.55111.11102.48102.48101.43

98.30

97.27

95.22

93.19

90.20

85.31

82.44

80.56

80.56

78.69

79.62

78.69

75.94

71.46

70.58

68.84

67.98

67.98

66.27

65.42

61.27

58.84

58.84

57.25

ページ(2)

13-1program.for.txt
c ********************************************************
c 第13回ゼミc
河道におけるKinematic wave法と貯留関数法の関係c
無次元Kinematic waveモデルによる解c （一山と二山三角形流入ハイドロによる応答）cc 作成者 宮武 真由子
作成日 2004.12.27
c ********************************************************cdimension q0(500),qs0(100),qs1(100),qs(500),ss(500)integer t,h,j,iq
real m,alph,tr,ta,ta1,ta2,ta3,te,dt,ti,dx,sp,qi1,qi2
real ome,er,f,ff,fff,c,d,q1,q2,f1,f2,asopen(2,file='kinema.out',status='unknown')c -------- input data -------m=0.6
alph=1.0! 無次元の場合α=1
dt=0.05! ｻﾝﾌﾟﾘﾝｸﾞ間隔
ti=int(1.0/dt)
dx=0.02! 河道長l=1を50分割
sp=int(1.0/dx)cc

一山か二山を選択
write(*,*)'input the number of peaks inflow data. (1or2)'
read(*,*)iq
if (iq.eq.2) go to 300--- input q (1peak) --ta=6.0
tr=12.0! ta/tr=0.50の場合
te=14.0q0(1)=0.0
do t=1,te*tiif((t.gt.0.0).and.(t.le.ta*ti)) thenq0(t)=2.0*t*dt/ta
else if((t.gt.ta*ti).and.(t.le.tr*ti)) thenq0(t)=-2.0*(t*dt-tr)/(tr-ta)
else if((t.gt.tr*ti).and.(t.le.te*ti)) thenq0(t)=0.0
end ifend dogo to 400c--- input q (2peaks) --300 ta1=1.5
ta2=3.0ta3=7.5
tr=12.0
te=14.0
qi1=1.1429! 第1ピーク値
qi2=2.2857! 第2ピーク値
q0(1)=0.0
do t=1,te*tiif((t.gt.0.0).and.(t.le.ta1*ti)) thenページ(1)

13-1program.for.txt
q0(t)=qi1*t*dt/ta1
else if((t.gt.ta1*ti).and.(t.le.ta2*ti)) thenq0(t)=-qi1*(t*dt-ta2)/(ta2-ta1)
else if((t.gt.ta2*ti).and.(t.le.ta3*ti)) thenq0(t)=qi2*(t*dt-ta2)/(ta3-ta2)else if((t.gt.ta3*ti).and.(t.le.tr*ti)) thenq0(t)=-qi2*(t*dt-tr)/(tr-ta3)else if((t.gt.tr*ti).and.(t.le.te*ti)) thenq0(t)=0.0
end ifend doc -------- calculation of q -------400 do j=1,sp
qs0(j)=0.0! 初期条件end dodo i=1,te*ti-1
do k=1,sp
qs1(k)=0.0
end doqs0(1)=q0(i); qs1(1)=q0(i+1)

ccc! 上流端流入流量の更新

do j=1,sp-1
ome=dt/dx*qs1(j)+alph*qs0(j+1)**m
er=0.01*ome--- initial condition qs1(j+1) --if ((qs0(j+1).eq.0.0).and.(qs1(j).eq.0.0)) thenqs1(j+1)=0.0
go to 200
endif
c=((qs0(j+1)+qs1(j))/2.0)**(m-1.0)
qs1(j+1)=(dt/dx*qs1(j)+alph*m*qs0(j+1)*c)+/(dt/dx+alph*m*c)
do h=1,100
write(2,*) i,j,h-----f=dt/dx*qs1(j+1)+alph*qs1(j+1)**m
ff=dt/dx+alph*m*qs1(j+1)**(m-1.0)
fff=alph*m*(m-1.0)*qs1(j+1)**(m-2.0)
d=abs((ff/fff)**2.0-2.0*(f-ome)/fff)**0.5
q1=qs1(j+1)-ff/fff+dq2=qs1(j+1)-ff/fff-d
if (q1.lt.0.00001) thenqs1(j+1)=0.0
go to 100
else if(q2.lt.0.00001) thenqs1(j+1)=0.0
go to 100
endif
f1=dt/dx*q1+alph*q1**m
f2=dt/dx*q2+alph*q2**m
if (abs(f1-ome).le.abs(f2-ome)) thenqs1(j+1)=q1
if (abs(f1-ome).le.er) go to 100
else
qs1(j+1)=q2
ページ(2)

13-1program.for.txt
if (abs(f2-ome).le.er) go to 100
end ifcontinueend do100

continueend do200

continue
as=0.0do k=1,sp! 流量の受け渡し計算
qs0(k)=qs1(k)as=as+qs1(k)**m
end doqs(i+1)=qs1(sp)ss(i+1)=dx*(as-(qs1(1)+qs1(sp))/2.0)
end doc -------- output data -------write (2,*)' malph'write (2,'(2f11.6)') m,alphwrite (2,*) ' nq0qs
do i=1,te*ti
write (2,'(i7,3f12.7)') i,q0(i),qs(i),ss(i)end dostopend

ページ(3)ss'

13-2program.for.txt
c ********************************************************
c 第13回ゼミc
河道におけるKinematic wave法と貯留関数法の関係c
無次元貯留関数法による解c （一山と二山三角形流入ハイドロによる応答）cc 作成者 宮武 真由子
作成日 2004.12.27
c ********************************************************cdimension q0(500),qs(500),ss(500)real k1,k2,p1,p2
real x1,x2,y1,y2,dreal m,tr,ta,ta1,ta2,ta3,te,dt,ti,qi1,qi2
real a1,a2,a3,a4,wa,wb,wc,wd,rb,rd,h,h2,h3,h4
integer t,hh,i,iq
open(2,file='nls.out',status='unknown')c -------- input data -------m=0.6
dt=0.05! ｻﾝﾌﾟﾘﾝｸﾞ間隔
ti=int(1.0/dt)
tk=0.01! 計算時間間隔
tt=int(dt/tk)
k1=0.9145
k2=0.5635
p1=0.7453
p2=0.2200
h=tk; h2=h**2.0; h3=h2*h; h4=h3*hcc

一山か二山を選択
write(*,*)'input the number of peaks inflow data. (1or2)'
read(*,*)iq
if (iq.eq.2) go to 300--- input q (1peak) --ta=6.0
tr=12.0! ta/tr=0.50の場合
te=14.0q0(1)=0.0
do t=1,te*tiif((t.gt.0.0).and.(t.le.ta*ti)) thenq0(t)=2.0*t*dt/ta
else if((t.gt.ta*ti).and.(t.le.tr*ti)) thenq0(t)=-2.0*(t*dt-tr)/(tr-ta)
else if((t.gt.tr*ti).and.(t.le.te*ti)) thenq0(t)=0.0
end ifend dogo to 400c--- input q (2peaks) --300 ta1=1.5
ta2=3.0ta3=7.5
tr=12.0
ページ(1)

13-2program.for.txt
te=14.0
qi1=1.1429
qi2=2.2857! 第1ピーク値! 第2ピーク値

q0(1)=0.0
do t=1,te*tiif((t.gt.0.0).and.(t.le.ta1*ti)) thenq0(t)=qi1*t*dt/ta1
else if((t.gt.ta1*ti).and.(t.le.ta2*ti)) thenq0(t)=-qi1*(t*dt-ta2)/(ta2-ta1)
else if((t.gt.ta2*ti).and.(t.le.ta3*ti)) thenq0(t)=qi2*(t*dt-ta2)/(ta3-ta2)else if((t.gt.ta3*ti).and.(t.le.tr*ti)) thenq0(t)=-qi2*(t*dt-tr)/(tr-ta3)else if((t.gt.tr*ti).and.(t.le.te*ti)) thenq0(t)=0.0
end ifend doc -------- calculation of q,s -------c -------- second order nonlinear storage function method -------400 do i=1,te*ti
do hh=1,tt
if (y1.eq.0.0) thena1=0.0
go to 100endif
a1=-k1/k2*p1/p2*(p1/p2-1.0)*y1**(p1/p2-2.0)*y2+-y1**(1.0/p2-1.0)/(k2*p2)
100
a2=-k1/k2*p1/p2*y1**(p1/p2-1.0)
a3=a1+a2**2.0
a4=a1+a3
c---- elements of phi matrix
wa=1.0+0.5*a1*h2+a1*a2*h3/6.0+a1*a3*h4/24.0
wb=h*(1.0+0.5*a2*h+a3*h2/6.0+a2*a4*h3/24.0)
wc=a1*wb
wd=1.0+a2*h+0.5*a3*h2+a2*a4*h3/6.0+(a1*a3+a2**2.0*a4)*h4/24.0
c---- elements of gamma matrix
rb=h2*(0.5+a2*h/6.0+a3*h2/24.0)
rd=wb
c
+

-----d=k1/k2*p1/p2*(p1/p2-1.0)*y2*y1**(p1/p2-1.0)+(1.0/p2-1.0)*y1**(1.0/p2)/k2+q0(i)/k2
x1=wa*y1+wb*y2+rb*dx2=wc*y1+wd*y2+rd*d
y1=x1
y2=x2
if(y1.lt.0.0) y1=0.0
end doqs(i)=x1**(1.0/p2)
ss(i)=k1*x1**(p1/p2)+k2*x2
end doページ(2)

13-2program.for.txt
c -------- output data -------write (2,*)' k1
k2
p1
write (2,'(5f11.6)') k1,k2,p1,p2,mwrite (2,*) ' nq0qs
do i=1,te*ti
write (2,'(i7,4f12.7)') i,q0(i),qs(i),ss(i)end dostopend

ページ(3)

p2
ss'm'

14-1programl.f.txt
c ********************************************************
c 第14回ゼミc
複合流域における貯留関数法の最適化
c
有効雨量を用いた一般化貯留関数法
cc 作成者 秋田 大輔
作成日 2005.6.27
c ********************************************************cc
2価の非線形貯留方程式のパラメータ最適化c
河道追跡における一般化貯留関数モデルパラメータ同定c
支川に分割流域と河道を含む計算を考慮
c
c
上流端河道流入量がない場合の計算例
cccccc
有効雨量と直接流出高の入力
ccccccc
c*** 河道追跡における貯留関数法は無次元で計算 ***cc..............................................
c
一階ニュートン(newton)法
cfriction factor fc の１次元探索c
ヤコビアン(jacobian)行列（一次微係数）
c*****************************************
cstorage-discharge relationshipcs = k11*q**p1 + k12*d(q**p2)/dtc
optimization of parameters k11 and k12cp1 = 0.6 and p2 = 0.4648cck11=2.8235*fc*area**0.24
cc
k12=0.2835*k11**2*rave**(-0.2648)
c**********************************************
coptimize the friction factor fc
c**********************************************
cc==========================================================
character suikei*128,kasen*128,chiten*128,kouzui*128,& gp*128,chitenr*128,chiten1*128,chitenl*128cdimension q(200)dimension x(9),u(18),er(200)dimension rave(50),uut(18),ut(200,20),qc(200),uua(200),qqt(200),&qinlt(200,20)ccommon/st1/wk1,wk2,wp1,wp2,rain,q0in,fc,zfc
common/st2/n,m,m1,m2,h,h2,h3,h4c+++++++++++++++++++++++++++++++++++c
未知パラメータの個数 m=1c+++++++++++++++++++++++++++++++++++
common/date/iy,im,id,ih,nq,nr,nban,area(50)common/discha/r0(50,200),qr0(200),qt(200,20)
common/st3/nl,kount,p,ncal,nind,ndatc
パラメータの初期値設定
common/st4/cp1,cp2
common/tit/title
common/st5/jdg(90),chitenl(10),cleg(40),alph(40),cmm(40)common/st6/qinl(200),chitenr(20),chiten1ccommon/alpha/alp(3)c
ページ(1)

14-1programl.f.txt
dimension dlqt(5,200,20),dlut(5,200,20),dlqbt(5),r(50,200),q0(200)copen(1,file='input3.dat',status='unknown')
open(5,file='河道追跡fc.out',status='unknown')cwrite(5,*)'分割流域流出・河道追跡を含む複合流域解析'
write(5,*)'有効雨量と直接流出高を用いた一般化貯留関数法の最適化'
write(5,*)'friction factor fc の１次元探索'
write(5,*)'河道追跡における貯留関数法は無次元で計算'
write(5,*)'一階ニュートン法(一次微係数使用)'
write(5,'()')
cc==== READ ======================================
call input
c==== 流量・雨量の設定 ==========================careatot=0.0
do j=1,nban
areatot=areatot+area(j)end docdo i=1,nq
q0(i)=qr0(i)*areatot/3.6q(i)=q0(i)end docdo i=1,nban+1
do j=1,nrr(i,j)=r0(i,j)
end doend docc==== 分割流域における平均雨量強度の算出 ========
cdo j=1,nban
rtot=0.0
nrt=0
do i=1,nr
if(r(j,i).gt.0.0) thenrtot=rtot+r(j,i)
nrt=nrt+1
end ifend dorave(j)=rtot/float(nrt)
end docc
基準点での平均流域雨量強度c
trave = 基準点平均雨量強度
nzero=0
rtot=0.0
do 199 i=1,nr
if(r(nban+1,i).eq.0.0) go to 199
nzero=nzero+1
rtot=rtot+r(nban+1,i)
199 continue
xnz=nzero
trave=rtot/xnzc
ページ(2)

14-1programl.f.txt
write(5,'()')
write(5,210)
210 format('
流域面積',' 平均有効雨量強度',' fc初期値')
write(5,'(2f11.2,f13.3)') areatot,trave,fccc==== パラメータ設定 ============================czfc=1.0cgp='NO
fc
rmse
kai2'
write(5,'(/a80)') gpcdt=3600.0!サンプリング時間は1時間
xnl=nlxnq=nqfac=0.0cc 上流端河道流入量を分割数(nl)ごとに設定
cdo i=1,nq
do k=1,nlif(i.eq.1) thenqinlt(i,k)=qinl(i)elseqinlt(i,k)=qinl(i-1)+float(k)*(qinl(i)-qinl(i-1))/xnl
end ifend doend docc==== 最適化開始（一階ニュートン法）=======================
cdo 999 kkll=1,kount
c
ibn=0
icn=0
do ll=1,nq
do i=1,nlif(nind.eq.0) thenqt(ll,i)=0.0
else
qt(ll,i)=qinlt(ll,i)
end ifut(ll,i)=0.0
end doqqt(ll)=qt(ll,nl)
end doqbt=0.0
iscl=0
jscl=0c
do 900 nnl=1,ndatcjdg=1；河道追跡計算、jdg=0；分割流域流出計算
jjdg=jdg(nnl)
kscl=jjdg/10
c 支川合流判断if(jscl.eq.0.and.kscl.eq.0) go to 906
if(kscl.ne.0) go to 907
c 本川へ合流、保存量（上流端流量）全てを合計して下流へ
ページ(3)

14-1programl.f.txt
do kkl=1,jscl
do ll=1,nq
do i=1,nl
qt(ll,i)=qt(ll,i)+dlqt(kkl,ll,i)ut(ll,i)=ut(ll,i)+dlut(kkl,ll,i)end doqqt(ll)=qqt(ll)+dlqt(kkl,ll,nl)
end doqbt=qbt+dlqbt(kkl)
end dojscl=0
iscl=0c ** 支川合流点で下流に河道も流域もない場合
if(jjdg.eq.2) go to 905
go to 906
907 if(kscl-iscl) 902,906,904
c 支川合流終了、同じ支川に分割流域・河道が結合、c
支川から新たな支川発生
902 if(jscl.le.1) stopc 合流支川部に保存量（上流端流量）を加える
do ll=1,nq
do i=1,nl
qt(ll,i)=qt(ll,i)+dlqt(jscl,ll,i)ut(ll,i)=ut(ll,i)+dlut(jscl,ll,i)end doqqt(ll)=qqt(ll)+dlqt(jscl,ll,nl)
end doqbt=qbt+dlqbt(jscl)
jscl=jscl-1
iscl=kscl
go to 906
904 jscl=jscl+1
c 新たな支川が発生、ランク（jscl）を加え、
c 支川番号(iscl）を保存する
c 今まで累加した量を保存し、流出量等をクリアする
iscl=kscl
do ll=1,nq
do i=1,nldlqt(jscl,ll,i)=qt(ll,i)qt(ll,i)=0.
dlut(jscl,ll,i)=ut(ll,i)ut(ll,i)=0.
end dodlqt(jscl,ll,nl)=qqt(ll)qqt(ll)=0.
end dodlqbt(jscl)=qbt
qbt=0.
906 jjdg=jjdg-kscl*10
c 分割流域か河道かの判断cif(jjdg.eq.1) go to 901cc==== 分割流域における流出計算 ==================
cc
ibn:河道番号c
ibn=ibn+1
ページ(4)

14-1programl.f.txt
分割流域での流出計算時間間隔
h=1./xnl
h2=h*hh3=h2*hh4=h3*hc 貯留関数モデル定数 k1, k2, p1, p2の設定
wk1=2.8235*fc*zfc*area(ibn)**0.24
zk2=0.2835*wk1**2*rave(ibn)**(-0.2648)
wk2=1./zk2
wp1=cp1
zp2=cp2
wp2=1./zp2c
alp(1)=2.8235*area(ibn)**0.24
alp(2)=0.2835*rave(ibn)**(-0.2648)
alp(3)=alp(1)**2*alp(2)cc 流量と感度係数の初期値設定
do i=1,nx(i)=0.0
end dox(1)=0.0
do i=1,2u(i)=0.0
end docdo ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ibn,ll)
do k=1,nlc**solution of sensitivity equation
call gesto(x,u,1)c**solution of differential equation
call gesto(x,u,2)
if(x(1).le.0.0) x(1)=0.0
qcc=0.0
if(x(1).gt.0.0) qcc=x(1)**wp2
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)cc
流域流出量の累計（次の河道への流入量）c
流域流出量の感度係数ベクトルの累計（次の河道へ伝達）
qt(ll,k)=qt(ll,k)+qcc*area(ibn)/3.6
ut(ll,k)=ut(ll,k)+area(ibn)/3.6*cc*u(1)end doqcc=0.0
if(x(1).gt.0.0) qcc=x(1)**wp2
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)
qc(ll)=qcc
qqt(ll)=qt(ll,nl)
qbt=qbtuua(ll)=cc*u(1)*fccc
qt:分割流域からの流出量(次の河道流入量)(累計)(計算時間間隔毎)
cqqt:分割流域からの流出量（次の河道流入量）（累計）c（１時間毎）チェック用c
ut:分割流域の感度係数（累計）（計算時間間隔毎）c

ページ(5)

cc
c

14-1programl.f.txt
qbt:流域毎の初期流量の合計
uua:感度係数ベクトル（１時間毎）チェック用
end doc
go to 905
901 continuecc==== 河道追跡計算（無次元領域） ================c
icn=icn+1cccta,trの抽出 ...............................
call tatrst( nq,qqt,ts,ta,tr )cta/tr=0.5と仮定しても実用上問題なし
ta = tr*0.5cc 貯留関数モデル定数k3,k4,p3,p4を計算....
amm=cmm(icn)ccall kpxcal( amm,ta,tr,wk1,wk02,wp1,wp02 )c
totq = 0.0
ncalgt = 0
do i = nint(ts),nint(ts+tr)
totq = totq+qqt(i)ncalgt = ncalgt+1
end docc
上流端平均流入量(qm)qm = totq/float(ncalgt)cc
時間規準化(t* = ttt)
ttt = alph(icn)*cleg(icn)*qm**(cmm(icn)-1.0)c
wk3=wk1
zk4=wk02
wp3=wp1
zp4=wp02
c 河道追跡における無次元計算時間間隔(h)h=dt/ttt/xnl
h2=h*hh3=h2*hh4=h3*hc
wk1=wk3zk2=zk4
wk2=1./zk2
wp1=wp3
zp2=zp4
wp2=1./zp2
c 河道流量と感度係数の初期値設定
do i=1,nx(i)=0.0
end dox(1)=(qt(1,1)/qm)**zp2cページ(6)

14-1programl.f.txt
u(1)=0.0
u(2)=0.0c
do 31 ll=1,nq
do 41 k=1,nl
rain=qt(ll,k)/qmc 無次元量へ変換
c 強制項（＝上流端流入量に関する感度係数）
uut(1)=ut(ll,k)/qmc**solution of sensitivity equation
call gesto2(x,u,uut,1)c**solution of differential equation
call gesto2(x,u,uut,2)
if(x(1).le.0.0) x(1)=0.0
qcc=0.0
if(x(1).gt.0.0) qcc=x(1)**wp2
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)c 実領域での流出量と感度係数へ変換
qt(ll,k)=qcc*qm
ut(ll,k)=cc*u(1)*qm
41 continuecqqt(ll)=qt(ll,nl)
31 continuec
905 continuec
900 continuecc==== 目的関数値と相対誤差計算 ==================csum=0.0
sotai=0.0
sigev=0.0
sigv=0.0c
do 32 ll=1,nq
qq=q0(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)c
誤差項
err=qq-qt(ll,nl)er(ll)=err
if(qq.eq.0.0) go to 49
erw=(err/qs)*(3.6/areatot)**0.5
skai2=skai2+erw**2
sotai=sotai+abs(err)/qq
49 continue
sum=sum+(err*3.6/areatot)**2cc
１時間毎の感度係数ベクトル抽出
sigev=sigev+er(ll)*ut(ll,nl)*fc
sigv=sigv+(ut(ll,nl)*fc)**2
32 continuecsum=sqrt(sum/xnq)!rmse
skai2=skai2/xnq!kai2
ページ(7)

14-1programl.f.txt
cwrite(5,'(i2,3f9.4)') kkll,fc*zfc,sum,skai2cdfc=sigev/sigvccol = abs(dfc/zfc)
if(col.gt.p) go to 877
go to 879
877 fac = 0.5*(1.+fac)
dfc=fac*dfc
xnew=zfc+dfc
if(xnew.gt.0.0) zfc=zfc+dfc
999 continue
879 continuecc==== WRITE =====================================c
rtot=0.0
qtot=0.0
qctot=0.0
qsotai=0.0
qsotai2=0.0
qsotai3=0.0
qmax=-999.99
qmaxc=-999.99
do 502 i=1,nqif(q0(i).gt.qmax) qmax=q0(i)!観測ピークif(qt(i,nl).gt.qmaxc) qmaxc=qt(i,nl) !計算ピーク
502 continue
iko=0.0
do 503 i=1,nq
rtot=rtot+r(nban+1,i)
qtot=qtot+q0(i)qctot=qctot+qt(i,nl)
if(q0(i).lt.0.04*areatot/3.6) go to 500
iko=iko+1
qsotai=qsotai+abs(q0(i)-qt(i,nl))/q0(i)qsotai2=qsotai2+((q0(i)-qt(i,nl))/q0(i))**2
500 continue
qsotai3=qsotai3+((q0(i)-qt(i,nl))/qmax)**2
503 continue
xiko=ikoqtot0=3.6*qtot/areatot!観測流出高qctot0=3.6*qctot/areatot!計算流出高hiryu=qmax/areatot!比流量peakg=abs(qmax-qmaxc)/qmax!Jpe（ピーク相対誤差）
qsotai=qsotai/xiko!Jre（ハイドログラフ相対誤差）
qsotai2=qsotai2/xiko!Ewqsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmax-qmaxc)/qmax!Epcc--OUTPUT 2
write(5,'()')
write(5,211)
211 format(2x,'収束回数',5x,'fc',8x,'rmse'& ,8x,'kai2',9x,'Jpe',9x,'Jre')write(5,'(i7,8f12.3)') kkll,fc*zfc,sum,skai2,peakg,qsotai
ページ(8)

14-1programl.f.txt
write(5,'()')
write(5,214)
214 format(7x,'Ew',9x,'E',8x,'Ev',8x,'Ep')
write(5,'(4f10.3)') qsotai2,qsotai3,qsotai4,qsotai5
write(5,'()')
write(5,212)
212 format(4x,'比流量',4x,'総雨量',2x,'観測総流出',3x,'計算総流出',3x,&'観測ピーク値',3x,'計算ピーク値')
write(5,'(3f10.3,4f15.3)') hiryu,rtot,qtot0,qctot0,qmax,qmaxc
write(5,'()')
cwrite(5,204)
204 format('NO',6x,'流域平均有効雨量',4x,'直接流出高'& ,4x,'計算直接流出高')
do i=1,nq
write(5,207) i,r(nban+1,i),qr0(i),qt(i,nl)*3.6/areatot
end do207 format(i8,3f16.4)
c
stop
end
c
c================================================
subroutine input
c================================================
c ***** 流域流出解析と河道追跡のためのデータ入力
c 分割流域の有効雨量を入力
c 検証地点での直接流出高入力ccharacter suikei*128,kasen*128,chiten*128,kouzui*128,& gp*128,chitenr*128,chiten1*128,chitenl*128ccommon/st1/wk1,wk2,wp1,wp2,rain,q0in,fc,zfc
common/st2/n,m,m1,m2,h,h2,h3,h4
common/date/iy,im,id,ih,nq,nr,nban,area(50)common/discha/r0(50,200),qr0(200),qt(200,20)
common/st3/nl,kount,p,ncal,nind,ndat
common/st4/cp1,cp2
common/tit/title
common/st5/jdg(90),chitenl(10),cleg(40),alph(40),cmm(40)common/st6/qinl(200),chitenr(20),chiten1cc
データの読み込みcn: 微分方程式階数（n=2) m: モデル定数の数（m=1)
c
nl:１時間の計算分割数ckount:最大繰り返し計算回数
p:収束条件cnban:流域数
ncal:河道数 nc2:下流に流域・河道がない合流点の数
cnind=0; 上流端流入量なし nind=1;上流端流入量有り
c
jdg:流域、河道の計算判別、計算順序---0;流域 1;河道ccleg:河道長 alph:α cmm:ｍ area:分割流域面積c
r:流域雨量 q0:基準点流量 qinl:上流端河道流入量c
流出モデル定数の初期値(cp1=0.6, cp2=0.4648)
cp1=0.6
cp2=0.4648cread(1,3) suikei!水系名
read(1,3) kasen!河川名read(1,3) chiten!観測所名
ページ(9)

14-1programl.f.txt
read(1,3) kouzui!洪水年月日3 format(a128)
4 format(4i5,2f8.0)
5 format(3f8.0)
read(1,4) n,m,nl,kount,pread(1,'(f8.0)') fc!fc初期値入力
read(1,'(2i5)') nr,nq!雨量個数・流出高個数
read(1,'(4i5)') iy,im,id,ih!洪水年月日read(1,'(4i5)') nban,ncal,nind,nc2
ndat=nban+ncal+nc2
read(1,'(20i5)') (jdg(i),i=1,ndat)c 河道定数入力
if(ncal.ge.1) thendo j=1,ncal
read(1,'(a40)') chitenl(j)read(1,'(i5,3f8.0)') no,cleg(j),alph(j),cmm(j)end doend ifc 分割流域の面積と流域平均雨量
do j=1,nban
read(1,'(a40)') chitenr(j)read(1,'(i5,f8.0)') no,area(j)read(1,'(10f8.0)') (r0(j,i) ,i=1,nr) !分割流域の有効雨量
end doread(1,'(a40)') gp
read(1,*) (r0(nban+1,i) ,i=1,nr)
read(1,'(a40)') chiten1c 実測流量read(1,*) (qr0(i),i=1,nq)!検証地点での直接流出高入力c
c
入力データ出力cwrite(5,'(''水系：'',a80)') suikei!水系
write(5,'(''河川名：'',a80)') kasen!河川名write(5,'(''観測地点：'',a80)') chiten!観測地点
write(5,'(''洪水年月日：'',a80)') kouzui!洪水年月日write(5,'(''洪水開始年月日時：'',4i5)') iy,im,id,ih
write(5,'()')
write(5,'('' 流量データ数=''i3,'' 計算時間間隔= 1/'',i2)') nq,nlwrite(5,'()')
write(5,'(4i5)') nban,ncal,nind,nc2
write(5,'()')
write(5,'(20i5)') (jdg(i),i=1,ndat)creturnendcc================================================
subroutine gesto(x,u,ijk)
c================================================
c ***** 分割流域における流出計算と感度係数算定cc**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18)common/st1/wk1,wk2,wp1,wp2,rain,q0in,fc,zfc
ページ(10)14-1programl.f.txt
common/st2/n,m,m1,m2,h,h2,h3,h4ccommon/alpha/alp(3)cwp3=wp1*wp2-1.0
con=wk1*wk2*wp1*wp2
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
14 a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c
a2=-con*da3=a1+a2**2
a4=a1+a3c**elements of phi matrix (transition matrix)
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrix
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
cif(ijk.eq.2) go to 104cc**solve sensitivity equationc
感度方程式の強制項計算
b=alp(1)*(-wk2*(wp1*wp2)*y1**wp3*y2)& +2.0*alp(3)*fc*zfc& *(wk2**2*(wk1*(wp1*wp2)*y1**wp3*y2+y1**wp2-rain))uu(1) = f1*u(1) + f2*u(2) + g2*buu(2) = f3*u(1) + f4*u(2) + g4*bcu(1)=uu(1)u(2)=uu(2)creturn104 continuec**solve system equation
b1=con*(wp1*wp2-1.)*d*y2+wk2*(wp2-1.)*e+wk2*rainy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
do 102 i=1,n102 x(i)=y(i)returnendcc================================================
ページ(11)

14-1programl.f.txt
subroutine gesto2(x,u,uut,ijk)
c================================================c***** 河道追跡流量と感度係数の算定c
数値解法は流域流出計算と同じcc**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18),uut(1)common/st1/wk1,wk2,wp1,wp2,rain,q0in,fc,zfc
common/st2/n,m,m1,m2,h,h2,h3,h4c
con=wk1*wk2*wp1*wp2
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
14 a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c
a2=-con*da3=a1+a2**2
a4=a1+a3c**elements of phi matrix (transition matrix)
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrix
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
cif(ijk.eq.2) go to 104cc**solve sensitivity equationc
強制項（＝上流端流入量に関する感度係数）b=wk2*uut(1)uu(1) = f1*u(1) + f2*u(2) + g2*buu(2) = f3*u(1) + f4*u(2) + g4*bcu(1)=uu(1)u(2)=uu(2)creturn104 continuec**solve system equation
b1=con*(wp1*wp2-1.)*d*y2+wk2*(wp2-1.)*e+wk2*rainy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
ページ(12)

14-1programl.f.txt
do 102 i=1,n102 x(i)=y(i)returnendcc================================================
subroutine tatrst( ncalx,qq,ts,ta,tr )
c================================================
c ***** 洪水継続時間とピーク流量生起時刻の算定
cdimension qq(1),qtot(0:720),xdt(720)cqtot(0) = 0.0
qmax= -9999.
do i = 1,ncalx
xdt(i) = float(i)qtot(i) = qtot(i-1)+qq(i)if( qq(i).ge.qmax ) thenqmax = qq(i)iqmx = i
end ifend docq25x = qmax*0.25
iq25 = 0
do i = 1,iqmx
if( qq(i).gt.q25x ) theniq25 = i-1
go to 100end ifend do100
if( iq25.eq.0 ) iq25 = iqmx
jq25 = 0
do i = ncalx,iqmx,-1
if( qq(i).gt.q25x ) then
jq25 = i+1
go to 200
end ifend do200
if( jq25.ge.ncalx ) jq25 = iqmxcrmin = 999.
its = 0do i = 2,iq25-1
call sokanl( xdt,qtot,1,i,r1 )call sokanl( xdt,qtot,i,iq25,r2 )r = (abs(1.-r1)+abs(1.-r2))*0.5
if( r.lt.rmin ) thenrmin = r
its = i
end ifend doif( its.eq.0 ) its = 1crmin = 999.
ite = 0do i = jq25+1,ncalx-1
if( i.eq.140 ) thenページ(13)

14-1programl.f.txt
end ifcall sokanl( xdt,qtot,i,ncalx,r1 )call sokanl( xdt,qtot,jq25,i,r2 )r = (abs(1.-r1)+abs(1.-r2))*0.5
if( r.lt.rmin ) thenrmin = rite = i
end ifend doif( ite.eq.0 )ite = ncalx

c
ts
= 1.0
itsa = iqmx-its
if( itsa.gt.0 ) thena = (qmax-qq(its))/float(itsa)b = qq(its)-a*float(its)if( nint(a*1000.).eq.0 ) thents = 1.
else
ts = -b/aif( ts.le.0. ) ts = 1.
end ifta = float(iqmx)-ts
else
ta = 1.0
end ifitsa = iqmx-ite
if( itsa.lt.0 ) thena = (qmax-qq(ite))/float(itsa)b = qq(ite)-a*float(ite)if( nint(a*1000.).eq.0 ) thente = ncalx
else
te = -b/a
end if
tr = te-ts
if( tr.ge.ncalx ) tr = ncalx
else
tr = ncalx
end ifcreturnendcc=================================================
subroutine sokanl(x,y,n1,n2,r)c================================================
dimensionx(1),y(1),xl(720),yl(720)cm = 0if( n1.lt.n2 ) thenn3 = 1else
n3 = -1
end ifdo i = n1,n2,n3
if(x(i).ge.0.0001 .and. y(i).ge.0.0001) thenm = m+1
ページ(14)

14-1programl.f.txt
xl(m) = x(i)yl(m) = y(i)end ifend doif( m.le.1 ) thenr = 0.0elsecsumxy = 0.0
sumx = 0.0
sumy = 0.0
sumx2 = 0.0
sumy2 = 0.0
do i = 1,msumxy = sumxy+xl(i)*yl(i)sumx = sumx +xl(i)sumy = sumy +yl(i)sumx2 = sumx2+xl(i)*xl(i)sumy2 = sumy2+yl(i)*yl(i)end doczm=float(m)bunsi = sumxy-sumx*sumy/zm
bunbo = (sumx2-sumx*sumx/zm)*(sumy2-sumy*sumy/zm)
if( bunbo.gt.0.0 ) thenr
= bunsi/bunbo
else
r
= 1.0
end ifend ifcreturnendcc================================================
subroutine kpxcal( amm,ta,tr,ak1,ak2,ap1,ap2 )
c================================================
c ***** 河道追跡貯留関数モデル定数算定の近似式cdimension a(0:3),b(0:4,4),c(0:4,4),d(0:4,4),e(0:4,4)
data b /0.8545, -4.8430, 33.8238, -72.2531, 49.7646
1,
0.2404, -1.1777,
8.0276, -16.2876,
9.80262,
0.5844, 0.9107, -32.9092, 96.5526, -80.2872
3, -0.3999, 10.4083, -47.3310, 71.7788, -31.9668 /data c /0.5229, 22.7545,-154.6917, 327.8772,-224.9687
1,
1.0848, 23.9708,-126.7464, 230.5159,-124.7640
2, -0.9989, -18.7643, 216.3786,-546.4481, 422.4272
3,
1.3325, -34.6802, 151.6250,-223.8849, 95.8506 /data d /-0.8426, -39.5757, 249.2689,-512.7692, 345.5463
1,
0.1929, -19.1466, 90.2282,-157.3522, 79.5772
2,
2.7263, 53.1813,-427.1458, 976.2463,-713.3760
3, -0.7202, 24.5035, -98.6764, 138.5036, -52.1388 /data e /0.2763, 22.4122,-130.0060, 259.4679,-171.6907
1,0.0000, 0.0000,
0.0000,0.0000,0.00002, -1.1199, -37.4282, 249.4726,-535.5305, 376.2721
3,0.0000, 0.0000,
0.0000,0.0000,0.0000 /c
tar = ta/tr
ページ(15)

14-1programl.f.txt
ccall a03cal( a(0),b(0,1),c(0,1),d(0,1),e(0,1),tar )ak1 = a(0)+a(1)*amm+a(2)*amm**2.+a(3)*amm**3.
ccall a03cal( a(0),b(0,2),c(0,2),d(0,2),e(0,2),tar )ak2 = a(0)*exp(a(1)*amm+a(2)*amm**2.)ccall a03cal( a(0),b(0,3),c(0,3),d(0,3),e(0,3),tar )ap1 = a(0)+a(1)*amm+a(2)*amm**2.+a(3)*amm**3.
ccall a03cal( a(0),b(0,4),c(0,4),d(0,4),e(0,4),tar )ap2 = a(0)+a(1)*amm+a(2)*amm**2.
creturnendcc================================================
subroutine a03cal( a,b,c,d,e,tar )c================================================c
implicit double precision (a-h,o-z)
dimension a(0:3),b(0:4),c(0:4),d(0:4),e(0:4)ca(0) = b(0)+b(1)*tar+b(2)*tar**2.+b(3)*tar**3.+b(4)*tar**4.
a(1) = c(0)+c(1)*tar+c(2)*tar**2.+c(3)*tar**3.+c(4)*tar**4.
a(2) = d(0)+d(1)*tar+d(2)*tar**2.+d(3)*tar**3.+d(4)*tar**4.
a(3) = e(0)+e(1)*tar+e(2)*tar**2.+e(3)*tar**3.+e(4)*tar**4.
c
returnend

ページ(16)

input3.txt
湧別川
湧別川
丸瀬布
２００１年９月１２日洪水
21
10
50 0.0010
3.000
93
93
2001
9
10
20
6
2
0
0
0
0
1
0
10
11
10
0
河道Ａ
1 20500.0 1.3834 0.6765
河道Ｂ
2 7300.0 1.5532 0.6642
ＡＲＥＡ１
1 130.17
1.6399 2.2037 2.2805 5.1248 4.7661
3.84363.4849 3.5617 3.8436 3.2030 1.9218
3.84360.6406 0.6406 0.6406 1.2812 1.2812
0.64060.6406 0.3587 0.0000 0.6406 0.3587
0.6406
0.3587 0.6406 0.2819 0.3587 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000
ＡＲＥＡ２
2 143.80
1.3709 2.4727 2.0115 5.1248 5.0351
3.84363.7539 3.2927 3.8436 3.2030 1.9218
3.84360.6406 0.6406 0.6406 1.2812 1.2812
0.64060.6406 0.0897 0.0000 0.6406 0.0897
0.64060.0897 0.6406 0.5509 0.0897 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000
ＡＲＥＡ３

4.56114.56112.56243.56172.56242.9211

4.40734.1255

1.92180.6406

1.92180.99930.92250.99930.35870.64060.00000.44000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00004.02304.02302.56243.29272.56242.6521

4.94544.3945

1.92180.6406

1.92180.7303

1.19150.73030.08970.64060.00000.86000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.0000

ページ(1)

input3.txt
382.94
1.4285 1.6848
3.58102.9788 3.7667
4.26640.9097 0.8328
0.64060.8648 0.6406
0.90970.7943 0.6406
0.00000.3000 0.0500
0.00000.0000 0.0000
0.00000.0000 0.0000
0.00000.0000 0.0000
0.00000.0000 0.0000
ＡＲＥＡ４4 280.31
1.3773 1.8129
3.84363.4208 3.3055
4.17030.9673 0.6406
0.64060.6406 0.4228
0.96730.4228 0.6406
0.00000.0000 0.0000
0.00000.0000 0.0000
0.00000.0000 0.0000
0.00000.0000 0.0000
0.00000.0000 0.0000
ＡＲＥＡ５
5
44.18
0.8584 1.3260
3.37602.7802 3.5874
4.82371.2812 1.0186
0.6406
1.0634 0.6406
1.28120.9801 0.6406
0.00000.6000 0.0700
0.00000.0000 0.0000
0.00000.0000 0.0000

2.24855.31704.65084.59954.65082.83793.52973.65143.13252.22292.56243.4272

3.88843.88840.71751.5054

1.5823

1.92180.90971.68481.51820.2691

0.83280.6406

0.95451.42850.87760.86480.26910.64060.22420.00000.42000.00000.07000.00000.00000.00000.00000.00000.00000.00000.30000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00001.6976

5.12485.02873.39523.4016

3.20942.97883.84363.20302.24852.56242.98524.59954.38170.96091.2812

1.60791.92180.9673

1.59511.38370.32670.6406

0.42281.50540.74310.74310.64060.54450.42280.00000.00000.85000.00000.50000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00001.70405.50924.99673.5425

3.74753.37602.9852

3.4656

3.11332.60722.56243.62584.06144.06140.89681.70401.9666

1.92181.2812

1.32601.87700.64061.01860.6406

1.49901.44781.23641.06340.64060.6406

0.42280.00001.00000.00000.34000.00000.00000.00000.00000.00000.00000.00000.60000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.0000ページ(2)

input3.txt
0.00000.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000
ＡＲＥＡ６6 120.60
1.1531 1.7873 2.1780 5.2593 4.1127 5.1120 4.2344 2.6969 3.4592
3.20302.8186 3.5938 3.7091 2.6969 2.5624 2.5624 3.5874 3.8436 3.8436
4.11271.0250 0.7751 0.8904 1.6656 1.9218 1.9218 1.0250 1.7873 1.4157
0.64061.0250 0.6406 0.3844 0.7751 0.6406 1.0250 1.4157 0.7751 1.0250
1.02500.5189 0.6406 0.3844 0.6406 0.3844 0.0000 0.6000 0.0000 0.0000
0.00000.2100 0.3900 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.2100 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000
丸瀬布地点流域平均有効雨量
1.361771 1.950706 1.978062 5.186077 4.808627 4.087803 3.974663
2.882071
3.259262 3.694348 3.319379 3.451363 3.782676 3.114672 2.201214
2.562400
3.086621 4.413493 4.192839 4.095963 0.875699 0.701524 0.812183
1.385475
1.560614 1.921800 0.875699 1.730052 1.250055 0.640600 0.744875
0.419946
0.235099 0.701524 0.419946 1.224938 0.993238 0.609455 0.744875
0.875699
0.436246 0.640600 0.455753 0.419946 0.104275 0.000000 0.711448
0.000000
0.200726 0.000000 0.095656 0.067673 0.000000 0.000000 0.000000
0.000000
0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.095656
0.000000
0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
0.000000
0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
0.000000
0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
0.000000
0.000000 0.000000 0.000000 0.000000 0.000000
丸瀬布地点直接流出高
0.003411 0.016374 0.023523 0.129497 0.230115 0.385174 0.590781
0.8292410.960343 1.071099 1.141725 1.191243 1.265854 1.401141 1.552027
1.738390
1.857268 1.920897 2.025711 2.154036 2.350736 2.589758 2.642277
2.745701
2.658581 2.572659 2.476555 2.315424 2.180500 2.080521 1.941551
1.886504
ページ(3)

1.792466
1.291139
1.269595
0.985421
0.957754
0.657983
0.613118
0.542833
0.518979
0.376090
0.336065
0.236739
0.237942
0.065021
0.080586

1.671622

1.610329

input3.txt
1.549916 1.472195

1.404925

1.330138

1.231183

1.209932

1.155533

1.077776

1.049374

0.974257

0.922666

0.858049

0.883587

0.769014

0.729123

0.717712

0.628866

0.577852

0.586670

0.595585

0.551600

0.560320

0.508154

0.459365

0.448736

0.419614

0.378855

0.368495

0.302652

0.321444

0.299643

0.266719

0.296658

0.246708

0.194971

0.169075

0.170033

0.144431

0.134804

0.109691

0.056255

0.037168

0.018300

0.004383

ページ(4)

14-2programl.for.txt
c ********************************************************
c 第14回ゼミc
複合流域における貯留関数法の最適化
c
損失項を含む貯留関数法
cc 作成者 星 清、松木賢治
作成日 2005.7.4
c ********************************************************
cc
分割流域流出計算手法：損失項を含む貯留関数法
c(1段タンク型非線形貯留関数モデル) のパラメータ同定c
支川に分割流域と河道追跡を含む計算を考慮
c
河道追跡は無次元領域にて計算した後、解を実領域に変換cc
上流端条件を考慮した河道追跡が可能
c(subroutine inputのnindで制御)cc***
モデル定数 c11, c12及び c13の同時最適化***
cc
一階ニュートン法（newton method）c
ヤコビアン(jacobian)行列（一次微係数使用）
c************************************************************
ccstorage-discharge relationshipcs = k11*q**p1 + k12*d(q**p2)/dt
c
ds/dt = r-q-b+q0
cq0(t) =qb*exp(-ram*t)!基底流出量cqb = 初期流出高cram = ハイドログラフ低減部の減衰係数cb = k13*q (b = 損失高)ck11 = c11*A**(0.24)ck12 = c12*k11**2*(rave)**(-0.2648)cc13 = 1 + k13cp1 = 0.6 and p2 = 0.4648ccr= 観測雨量cq= 観測流量cc***********************************************************
coptimization of parameters c11, c12 and c13
c***********************************************************c-----------------------------------------------------character gp*128,chitenr*128,chiten1*128,chitenl*128cdimension q(200),pas(200,9),dpa(9),x(9),u(18)dimension er(200),z(9),uut(18),ut(18,200,20)
dimension co(9),rave(50),qb(50),qb0(50)dimension qc(200),uua(3,200),qqt(200),qinlt(200,20)
dimension dlqt(5,200,20),dlut(5,18,200,20),dlqbt(5)ccommon/st1/wk1,wk2,wp1,wp2,wc3,rain,q0in
common/st2/n,m,m1,m2,h,h2,h3,h4
common/date/iy,im,id,ih,nq,nr,nban
common/discha/r(50,200),q0(200),qt(200,20),q00(50,200),area(50)common/st3/nl,kount,p,ncal,nind,ndat
common/st4/cc1,cc2,cc3,cp1,cp2,areatot,trave,ram,areaj
common/st5/jdg(90),chitenl(10),cleg(40),alph(40),cmm(40)common/st6/qinl(200),chitenr(20),chiten1c
ページ(1)

14-2programl.for.txtcopen(1,file='input.dat',status='unknown')
open(5,file='河道追跡.out',status='unknown')ccwrite(5,*)'分割流域流出・河道追跡を含む複合流域解析'
write(5,*)'損失項を含む貯留関数法'
write(5,*)'1段タンク型非線形貯留関数モデルの最適化'
write(5,*)'一階ニュートン法(一次微係数使用)'
write(5,*)'モデル定数 c11, c12及びc13の同時最適化'
write(5,'()')
c
c
c
c
c

データ入力
****************************************
call input****************************************
分割流域別初期流量及び基底流出成分の計算
areatot=0.0
do j=1,nban
areatot=areatot+area(j)end doareatot=areatot+areaj!上流端流域面積を追加
do j=1,nban
qb0(j)=q0(1)*area(j)/areatot
qb(j)=3.6*qb0(j)/area(j)地下水流出成分の低減係数(ram : 入力データ）
q01=qb(j)do i=1,nq
q02=qb(j)*exp(-ram*i)q00(j,i)=(q01+q02)*0.5 !基底流出量cq01=q02end doend docc

基準点流量を流出高変換(mm/h)
do 1001 i=1,nq
1001 q(i)=3.6*q0(i)/areatot

c
c

c
c
c

分割流域における平均雨量強度の計算
do j=1,nban
rtot=0.0
nrt=0
do i=1,nr
if(r(j,i).gt.0.0) thenrtot=rtot+r(j,i)
nrt=nrt+1
end ifend dorave(j)=rtot/float(nrt)
end do
基準点での平均流域雨量強度
trave = 基準点平均雨量強度
nzero=0
rtot=0.0
do 199 i=1,nr
if(r(nban+1,i).eq.0.0) go to 199
ページ(2)

14-2programl.for.txt
nzero=nzero+1
rtot=rtot+r(nban+1,i)
199 continue
xnz=nzero
trave=rtot/xnz
cwrite(5,'()')
write(5,210)
210 format('
流域面積',' 平均雨量強度',' c11初期値','& 'c13初期値')
write(5,'(2f10.2,3f13.3)') areatot,trave,cc1,cc2,cc3ccc

規準化パラメータの設定
yc1=1.0
yc2=1.0
yc3=1.0モデル定数の初期値
co(1)=cc1
co(2)=cc2
co(3)=cc3ccwrite(5,'()')
write(5,'()')
gp='
No
c11
c12
&'
rmse
kai2'
write(5,'(a80)') gp

c13'//cdt=3600.0
xnl=nlm1=m+1m2=2*mxnq=nqfac=0.0ccc

上流端河道流入量を分割数(nl)ごとに設定
do i=1,nq
do k=1,nlif(i.eq.1) thenqinlt(i,k)=qinl(i)elseqinlt(i,k)=qinl(i-1)+float(k)*(qinl(i)-qinl(i-1))/xnl
end ifend doend doccc

最適化開始 （一階ニュートン法）
do 999 kkll=1,kount

c
ibn=0
icn=0
do ll=1,nq
do i=1,nlif(nind.eq.0) thenqt(ll,i)=0.0
else
ページ(3)

c12初期値',

14-2programl.for.txt
qt(ll,i)=qinlt(ll,i)
end ifut(1,ll,i)=0.0
ut(2,ll,i)=0.0
ut(3,ll,i)=0.0
end docqqt(ll)=qt(ll,nl)c
end doqbt=0.0
iscl=0
jscl=0c
do 900 nnl=1,ndat
jdg=1；河道追跡計算、jdg=0；分割流域流出計算
jjdg=jdg(nnl)
kscl=jjdg/10c
支川合流判断if(jscl.eq.0.and.kscl.eq.0) go to 906
if(kscl.ne.0) go to 907c
本川へ合流、保存量（上流端流量）全てを合計して下流へ
do kkl=1,jscl
do ll=1,nq
do i=1,nl
qt(ll,i)=qt(ll,i)+dlqt(kkl,ll,i)do j=1,3
ut(j,ll,i)=ut(j,ll,i)+dlut(kkl,j,ll,i)end doend doqqt(ll)=qqt(ll)+dlqt(kkl,ll,nl)
end doqbt=qbt+dlqbt(kkl)
end dojscl=0
iscl=0c ** 支川合流点で下流に河道も流域もない場合
if(jjdg.eq.2) go to 905
go to 906
907 if(kscl-iscl) 902,906,904c
支川合流終了、同じ支川に分割流域・河道が結合、c
支川から新たな支川発生
902 if(jscl.le.1) stopc
合流支川部に保存量（上流端流量）を加える
do ll=1,nq
do i=1,nl
qt(ll,i)=qt(ll,i)+dlqt(jscl,ll,i)do j=1,3
ut(j,ll,i)=ut(j,ll,i)+dlut(jscl,j,ll,i)end doend doqqt(ll)=qqt(ll)+dlqt(jscl,ll,nl)
end doqbt=qbt+dlqbt(jscl)
jscl=jscl-1
iscl=kscl
go to 906
904 jscl=jscl+1c

ページ(4)

14-2programl.for.txt
新たな支川が発生、ランク（jscl）を加え、支川番号(iscl）を保存する
今まで累加した量を保存し、流出量等をクリアする
iscl=kscl
do ll=1,nq
do i=1,nldlqt(jscl,ll,i)=qt(ll,i)qt(ll,i)=0.
do j=1,3dlut(jscl,j,ll,i)=ut(j,ll,i)ut(j,ll,i)=0.
end doend dodlqt(jscl,ll,nl)=qqt(ll)qqt(ll)=0.
end dodlqbt(jscl)=qbt
qbt=0.
906 jjdg=jjdg-kscl*10c
分割流域か河道かの判断cif(jjdg.eq.1) go to 901cc
分割流域における流出計算.........
c
ibn:河道番号c
ibn=ibn+1c
分割流域での流出計算時間間隔
h=1./xnl
h2=h*hh3=h2*hh4=h3*hc***
モデル定数の更新cc
表面・中間流出成分の定数c
貯留関数モデル定数 k11, k12, p1, p2の設定
wk1=cc1*yc1*area(ibn)**0.24
zk2=cc2*yc2*wk1**2*rave(ibn)**(-0.2648)
wk2=1./zk2
wp1=cp1
zp2=cp2
wp2=1./zp2
wc3=cc3*yc3cc
流量と感度係数の初期値設定
do 800 i=1,n
800 x(i)=0.0
x(1)=qb(ibn)**zp2
do 802 i=1,m2
802 u(i)=0.0c
do 30 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ibn,ll)
q0in=q00(ibn,ll)
do 40 k=1,nlc**solution of sensitivity equation
call gesto(x,u,1)ccc

ページ(5)

14-2programl.for.txt
solution of differential equation
call gesto(x,u,2)
if(x(1).le.0.0) x(1)=0.0
qcc=0.0
if(x(1).gt.0.0) qcc=x(1)**wp2
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)

c**

c
c
c
c

流域流出量の累計（次の河道への流入量）
流域流出量の感度係数ベクトルの累計（次の河道へ伝達）
qt(ll,k)=qt(ll,k)+qcc*area(ibn)/3.6
ut(1,ll,k)=ut(1,ll,k)+area(ibn)/3.6*cc*u(1)*area(ibn)**0.24
ut(2,ll,k)=ut(2,ll,k)+area(ibn)/3.6*cc*u(2)*wk1**2& *rave(ibn)**(-0.2648)
ut(3,ll,k)=ut(3,ll,k)+area(ibn)/3.6*cc*u(3)40 continueccqc(ll)=qcc
qqt(ll)=qt(ll,nl)
qbt=qbt+qb0(ibn)
表面・中間流出成分の感度係数
uua(1,ll)=cc*u(1)*area(ibn)**0.24
uua(2,ll)=cc*u(2)*wk1**2*rave(ibn)**(-0.2648)
uua(3,ll)=cc*u(3)

c
c
c
c
c
c
c
c

qt:分割流域からの流出量（次の河道流入量）（累計）（計算時間間隔毎）
qqt:分割流域からの流出量（次の河道流入量）（累計）（１時間毎）チェック用
ut:分割流域の感度係数（累計）（計算時間間隔毎）
qbt:流域毎の初期流量の合計
uua:感度係数ベクトル（１時間毎）チェック用
30 continuecgo to 905
901 continue
c
c
c
c
c
c
c
c
c
c

河道追跡計算（無次元領域）...........................
icn=icn+1
ta,trの抽出 ......................................
call tatrst( nq,qqt,ts,ta,tr )ta/tr=0.5と仮定しても実用上問題なし
ta = tr*0.5
河道追跡用貯留関数モデル定数 k3,k4,p3,p4を計算....
amm=cmm(icn)
無次元領域での貯留関数モデル定数 k3,k4,p3,p4
call kpxcal( amm,ta,tr,wk1,wk02,wp1,wp02 )c
totq = 0.0
ncalgt = 0
do i = nint(ts),nint(ts+tr)
totq = totq+qqt(i)ncalgt = ncalgt+1
ページ(6)

14-2programl.for.txt
end do
c
c
c
c
c
c

c

上流端平均流入量(qm)qm = totq/float(ncalgt)
時間規準化(t* = ttt)
ttt = alph(icn)*cleg(icn)*qm**(cmm(icn)-1.0)
河道追跡用貯留関数モデル定数の保存
wk3=wk1
zk4=wk02
wp3=wp1
zp4=wp02
河道追跡における無次元計算時間間隔(h)h=dt/ttt/xnl
h2=h*hh3=h2*hh4=h3*hcc

河道追跡計算のための貯留関数モデル定数の変数変換
wk1=wk3zk2=zk4
wk2=1./zk2
wp1=wp3
zp2=zp4
wp2=1./zp2c
河道流量と感度係数の初期値設定
do 804 i=1,n804 x(i)=0.0
x(1)=(qt(1,1)/qm)**zp2
do 806 i=1,m2
806 u(i)=0.0c
do 31 ll=1,nq
do 41 k=1,nl
rain=qt(ll,k)/qmc
無次元量へ変換c
強制項（＝上流端流入量に関する感度係数）
uut(1)=ut(1,ll,k)/qm
uut(2)=ut(2,ll,k)/qm
uut(3)=ut(3,ll,k)/qmc**solution of sensitivity equation
call gesto2(x,u,uut,1)c**solution of differential equation
call gesto2(x,u,uut,2)
if(x(1).le.0.0) x(1)=0.0
qcc=0.0
if(x(1).gt.0.0) qcc=x(1)**wp2
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)c
実領域での流出量と感度係数へ変換
qt(ll,k)=qcc*qm
ut(1,ll,k)=cc*u(1)*qm
ut(2,ll,k)=cc*u(2)*qm
ut(3,ll,k)=cc*u(3)*qm
41 continuecqqt(ll)=qt(ll,nl)
ページ(7)

14-2programl.for.txt
31 continuec
905 continuec
900 continuecc

目的関数(sum):カイ2乗(skai2):相対誤差(sotai)
sum=0.0
skai2=0.0
sotai=0.0c
do 32 ll=1,nq
qq=q0(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)
誤差項
err=qq-qt(ll,nl)er(ll)=err
if(qq.eq.0.0) go to 49
erw=(err/qs)*(3.6/areatot)**0.5
skai2=skai2+erw**2
sotai=sotai+abs(err)/qq
49 continue
sum=sum+(err*3.6/areatot)**2

c

c
c
c**

１時間毎の感度係数ベクトル抽出
sensitivity coefficientsdo 42 i=1,m42 pas(ll,i)=ut(i,ll,nl)
感度係数の規準化
do 43 i=1,m
43 pas(ll,i)=co(i)*pas(ll,i)

c
c
c**

error between observed and computed dischargespas(ll,m1)=err
32 continuecsum=sqrt(sum/xnq)
skai2=skai2/xnq

!rmse
!kai2

c
write(5,'(i5,3f8.3,3f10.3)') kkll,cc1*yc1,cc2*yc2,wc3,& sum,skai2cz(1)=yc1z(2)=yc2z(3)=yc3
c
c
c
c**
c**

ニュートン法によるモデル定数補正値計算（成分回帰分析法の利用）
component regression method
to solve the correction terms of parameterscall momreg(9,m1,200,nq,pas,dpa)
do 875 i=1,m
col = abs(dpa(i)/z(i))
if(col.gt.p) go to 877
875 continue
go to 879
ページ(8)

14-2programl.for.txt
877 fac = 0.5*(1.+fac)
do 878 i=1,mdpa(i)=fac*dpa(i)878 continue
do 991 i=1,mxnew=z(i)+dpa(i)if(xnew.gt.0.0) z(i)=z(i)+dpa(i)991 continuecc
if(z(3)*cc3.lt.1.0) z(3)=1.0/cc3cc
yc1=z(1)yc2=z(2)yc3=z(3)999 continue
879 continueccrtot=0.0
qtot=0.0
qctot=0.0
qsotai=0.0
qsotai2=0.0
qsotai3=0.0
qmax=-999.99
qmaxc=-999.99
do 502 i=1,nqif(q0(i).gt.qmax) qmax=q0(i)!観測ピークif(qt(i,nl).gt.qmaxc) qmaxc=qt(i,nl) !計算ピーク
502 continue
iko=0.0
do 503 i=1,nq
rtot=rtot+r(nban+1,i)
qtot=qtot+q0(i)qctot=qctot+qt(i,nl)
if(q0(i).lt.0.04*areatot/3.6) go to 500
iko=iko+1
qsotai=qsotai+abs(q0(i)-qt(i,nl))/q0(i)qsotai2=qsotai2+((q0(i)-qt(i,nl))/q0(i))**2
500 continue
qsotai3=qsotai3+((q0(i)-qt(i,nl))/qmax)**2
503 continue
xiko=ikoqtot0=3.6*qtot/areatot!観測流出高qctot0=3.6*qctot/areatot!計算流出高hiryu=qmax/areatot!比流量peakg=abs(qmax-qmaxc)/qmax!Jpe（ピーク相対誤差）
qsotai=qsotai/xiko!Jre（ハイドログラフ相対誤差）
qsotai2=qsotai2/xiko!Ewqsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmax-qmaxc)/qmax!Epcc--OUTPUT 2
write(5,'()')
write(5,211)
211 format(2x,'収束回数',5x,'c11',9x,'c12',9x,'c13',&8x,'rmse',8x,'kai2',9x,'Jpe',9x,'Jre')ページ(9)

14-2programl.for.txt
write(5,'(i7,8f12.3)') kkll,cc1*yc1,cc2*yc2,wc3,&sum,skai2,peakg,qsotai
write(5,'()')
write(5,214)
214 format(7x,'Ew',9x,'E',8x,'Ev',8x,'Ep')
write(5,'(4f10.3)') qsotai2,qsotai3,qsotai4,qsotai5
write(5,'()')
write(5,212)
212 format(4x,'比流量',4x,'総雨量',2x,'観測総流出',3x,'計算総流出',3x,&'観測ピーク値',3x,'計算ピーク値')
write(5,'(3f10.3,4f15.3)') hiryu,rtot,qtot0,qctot0,qmax,qmaxc
write(5,'()')
cwrite(5,204)
204 format('NO',6x,'実測雨量',6x,'実測流出高',6x,'計算流出高')
do i=1,nq
write(5,207) i,r(nban+1,i),q(i),qt(i,nl)*3.6/areatot
end do207 format(i8,f12.2,2f16.4)
c
stop
end
c
c-----------------------------------------------c***** 流域流出解析と河道追跡のためのデータ入力
csubroutine inputc-----------------------------------------------------character suikei*128,kasen*128,chiten*128,kouzui*128,& gp*128,chitenr*128,chiten1*128,chitenl*128ccommon/st1/wk1,wk2,wp1,wp2,wc3,rain,q0in
common/st2/n,m,m1,m2,h,h2,h3,h4
common/date/iy,im,id,ih,nq,nr,nban
common/discha/r(50,200),q0(200),qt(200,20),q00(50,200),area(50)common/st3/nl,kount,p,ncal,nind,ndat
common/st4/cc1,cc2,cc3,cp1,cp2,areatot,trave,ram,areaj
common/st5/jdg(90),chitenl(10),cleg(40),alph(40),cmm(40)common/st6/qinl(200),chitenr(20),chiten1cc
データの読み込みccn: 微分方程式階数（n=2) m: モデル定数の数（m=3)
c
nl:１時間の計算分割数 (nl=10)ckount:最大繰り返し計算回数 (kount=20) p:収束条件 (p=0.001)
cnban:流域数
ncal:河道数 nc2:下流に流域・河道がない合流点の数
cnind=0; 上流端流入量なし nind=1;上流端流入量有り
c
jdg:流域、河道の計算判別、計算順序---0;流域 1;河道ccleg:河道長 alph:α cmm:ｍ area:流域面積c
r:流域雨量 q0:基準点流量 qinl:上流端河道流入量ccp1=0.6 p2=0.4648！流出モデル定数
data cp1,cp2/0.6,0.4648/cread(1,3) suikei!水系名
read(1,3) kasen!河川名read(1,3) chiten!観測所名
read(1,3) kouzui!洪水年月日ページ(10)

c
c
c

c

c

c

c
c
c

14-2programl.for.txt
3 format(a128)
4 format(4i5,f8.0)
5 format(3f8.0)
read(1,4) n,m,nl,kount,pram = ハイドログラフ低減部の減衰係数
read(1,'(f8.0)') ram
初期値：c11,c12,c13
read(1,5) cc1,cc2,cc3
nr: 雨量データ数 nq: 流量データ数
read(1,'(2i5)') nr,nqread(1,'(4i5)') iy,im,id,ihread(1,'(4i5)') nban,ncal,nind,nc2
ndat=nban+ncal+nc2
read(1,'(20i5)') (jdg(i),i=1,ndat)
河道定数入力do j=1,ncal
read(1,'(a40)') chitenl(j)read(1,'(i5,3f8.0)') no,cleg(j),alph(j),cmm(j)end donind=1; 上流端流入量がある場合の入力
if(nind.ge.1) thenread(1,'(a40)') gp
read(1,'(f8.0)') areaj!上流端流域面積を追加
read(1,'(10f8.0)') (qinl(i),i=1,nq)
write(5,'()')
write(5,*)'nind = 1 : 上流端流入量境界条件'
write(5,'(a40)') gp
end if
分割流域の面積と流域平均雨量
do j=1,nban
read(1,'(a40)') chitenr(j)read(1,'(i5,f8.0)') no,area(j)read(1,'(10f8.0)') (r(j,i) ,i=1,nr)
end do
基準点における流域平均雨量入力
read(1,'(a40)') gp
read(1,'(10f8.0)') (r(nban+1,i) ,i=1,nr)

c
c
c
c
c

基準点実測流量の入力(m3/sec)read(1,'(a40)') chiten1
read(1,'(10f8.0)') (q0(i),i=1,nq)
入力データ出力
write(5,'(''水系：'',a80)') suikei!水系
write(5,'(''河川名：'',a80)') kasen!河川名write(5,'(''観測地点：'',a80)') chiten!観測地点
write(5,'(''洪水年月日：'',a80)') kouzui!洪水年月日write(5,'(''洪水開始年月日時：'',4i5)') iy,im,id,ih
write(5,'()')
write(5,'('' 流量データ数=''i3,'' 計算時間間隔= 1/'',i2)') nq,nlwrite(5,'()')
write(5,'(''λ(ramda)= '',f8.4)') ram
write(5,'()')
write(5,'(4i5)') nban,ncal,nind,nc2
write(5,'()')
ページ(11)

14-2programl.for.txt
write(5,'(20i5)') (jdg(i),i=1,ndat)creturnendcc-----------------------------------------------c***** 分割流域における流出計算と感度係数算定 *****csubroutine gesto(x,u,ijk)
c************************************************************
ccstorage-discharge relationshipcs = k11*q**p1 + k12*d(q**p2)/dt
c
ds/dt = r-q-b+q0
cq0(t) =qb*exp(-ram*t)!基底流出量cqb = 初期流出高cram = ハイドログラフ低減部の減衰係数cb = k13*q (b = 損失高)ck11 = c11*A**(0.24)ck12 = c12*k11**2*(rave)**(-0.2648)cc13 = 1 + k13cp1 = 0.6 and p2 = 0.4648ccr= 観測雨量cq= 観測流量cc**
ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equationc***********************************************************
dimension x(1),u(1),y(9),uu(18),b(9)common/st1/wk1,wk2,wp1,wp2,wc3,rain,q0in
common/st2/n,m,m1,m2,h,h2,h3,h4c
con=wk1*wk2*wp1*wp2
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
14 a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c*wc3
a2=-con*da3=a1+a2**2
a4=a1+a3c**elements of phi matrix (transition matrix)
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrix
ページ(12)

14-2programl.for.txt
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
if(ijk.eq.2) go to 104
c**solve sensitivity equationc
感度方程式の強制項計算b(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e*wc3 - rain-q0in)b(3)=-wk2*e
do 16 i=1,m
16 uu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
18 uu(i) = f3*u(i-m) + f4*u(i) + g4*b(i-m)
do 20 i=1,m2
20 u(i)=uu(i)return104 continuec**solve system equation
b1=con*(wp1*wp2-1.)*d*y2+wk2*wc3*(wp2-1.)*e+wk2*(rain+q0in)
y(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
do 102 i=1,n102 x(i)=y(i)returnendcc-----------------------------------------------c***** 河道追跡流量と感度係数の算定*****c
数値解法は流域流出計算と同じ
c
subroutine gesto2(x,u,uut,ijk)c**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equationc**ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18),b(9),uut(1)common/st1/wk1,wk2,wp1,wp2,wc3,rain,q0in
common/st2/n,m,m1,m2,h,h2,h3,h4c
con=wk1*wk2*wp1*wp2
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
14 a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c
a2=-con*da3=a1+a2**2
a4=a1+a3c**elements of phi matrix (transition matrix)
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
ページ(13)

14-2programl.for.txt
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrix
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
if(ijk.eq.2) go to 104
c**solve sensitivity equationc
強制項（＝上流端流入量に関する感度係数）b(1)=wk2*uut(1)b(2)=wk2*uut(2)b(3)=wk2*uut(3)do 16 i=1,m
16 uu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
18 uu(i) = f3*u(i-m) + f4*u(i) + g4*b(i-m)
do 20 i=1,m2
20 u(i)=uu(i)return104 continuec**solve system equation
b1=con*(wp1*wp2-1.)*d*y2+wk2*(wp2-1.)*e+wk2*rainy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
do 102 i=1,n102 x(i)=y(i)returnendcc-----------------------------------------------c***** 洪水継続時間とピーク流量生起時刻の算定
csubroutine tatrst( ncalx,qq,ts,ta,tr )dimension qq(1),qtot(0:720),xdt(720)cqtot(0) = 0.0
qmax= -9999.
do i = 1,ncalx
xdt(i) = float(i)qtot(i) = qtot(i-1)+qq(i)if( qq(i).ge.qmax ) thenqmax = qq(i)iqmx = i
end ifend docq25x = qmax*0.25
iq25 = 0
do i = 1,iqmx
if( qq(i).gt.q25x ) theniq25 = i-1
go to 100end ifend do100
if( iq25.eq.0 ) iq25 = iqmx
jq25 = 0
do i = ncalx,iqmx,-1
ページ(14)

14-2programl.for.txt
if( qq(i).gt.q25x ) then
jq25 = i+1
go to 200
end if200

end doif( jq25.ge.ncalx )jq25 = iqmxcrmin = 999.
its = 0do i = 2,iq25-1
call sokanl( xdt,qtot,1,i,r1 )call sokanl( xdt,qtot,i,iq25,r2 )r = (abs(1.-r1)+abs(1.-r2))*0.5
if( r.lt.rmin ) thenrmin = r
its = i
end ifend doif( its.eq.0 ) its = 1crmin = 999.
ite = 0do i = jq25+1,ncalx-1
if( i.eq.140 ) thenicv = 0end ifcall sokanl( xdt,qtot,i,ncalx,r1 )call sokanl( xdt,qtot,jq25,i,r2 )r = (abs(1.-r1)+abs(1.-r2))*0.5
if( r.lt.rmin ) thenrmin = rite = i
end ifend doif( ite.eq.0 ) ite = ncalx
c
ts
= 1.0
itsa = iqmx-its
if( itsa.gt.0 ) thena = (qmax-qq(its))/float(itsa)b = qq(its)-a*float(its)if( nint(a*1000.).eq.0 ) thents = 1.
else
ts = -b/aif( ts.le.0. ) ts = 1.
end ifta = float(iqmx)-ts
else
ta = 1.0
end ifitsa = iqmx-ite
if( itsa.lt.0 ) thena = (qmax-qq(ite))/float(itsa)b = qq(ite)-a*float(ite)if( nint(a*1000.).eq.0 ) thente = ncalx
else
ページ(15)

14-2programl.for.txt
te = -b/a
end if
tr = te-ts
if( tr.ge.ncalx )tr = ncalx

else
tr = ncalx
end ifcreturnendcc-----------------------------------------------subroutine sokanl(x,y,n1,n2,r)dimensionx(1),y(1),xl(720),yl(720)cm = 0if( n1.lt.n2 ) thenn3 = 1else
n3 = -1
end ifdo i = n1,n2,n3
if(x(i).ge.0.0001 .and. y(i).ge.0.0001) thenm = m+1
xl(m) = x(i)yl(m) = y(i)end ifend doif( m.le.1 ) thena = 1.0
b = 0.0
r = 0.0elsecsumxy = 0.0
sumx = 0.0
sumy = 0.0
sumx2 = 0.0
sumy2 = 0.0
do i = 1,msumxy = sumxy+xl(i)*yl(i)sumx = sumx +xl(i)sumy = sumy +yl(i)sumx2 = sumx2+xl(i)*xl(i)sumy2 = sumy2+yl(i)*yl(i)end doczm=float(m)bunsi = sumxy-sumx*sumy/zm
bunbo = (sumx2-sumx*sumx/zm)*(sumy2-sumy*sumy/zm)
if( bunbo.gt.0.0 ) thenr
= bunsi/bunbo
else
r
= 1.0
end ifend ifcreturnページ(16)

14-2programl.for.txt
endcc-----------------------------------------------c***** 河道追跡貯留関数モデル定数算定の近似式csubroutine kpxcal( amm,ta,tr,ak1,ak2,ap1,ap2 )cdimension a(0:3),b(0:4,4),c(0:4,4),d(0:4,4),e(0:4,4)
data b /0.8545, -4.8430, 33.8238, -72.2531, 49.7646
1,
0.2404, -1.1777,
8.0276, -16.2876,
9.80262,
0.5844, 0.9107, -32.9092, 96.5526, -80.2872
3, -0.3999, 10.4083, -47.3310, 71.7788, -31.9668 /data c /0.5229, 22.7545,-154.6917, 327.8772,-224.9687
1,
1.0848, 23.9708,-126.7464, 230.5159,-124.7640
2, -0.9989, -18.7643, 216.3786,-546.4481, 422.4272
3,
1.3325, -34.6802, 151.6250,-223.8849, 95.8506 /data d /-0.8426, -39.5757, 249.2689,-512.7692, 345.5463
1,
0.1929, -19.1466, 90.2282,-157.3522, 79.5772
2,
2.7263, 53.1813,-427.1458, 976.2463,-713.3760
3, -0.7202, 24.5035, -98.6764, 138.5036, -52.1388 /data e /0.2763, 22.4122,-130.0060, 259.4679,-171.6907
1,0.0000, 0.0000,
0.0000,0.0000,0.00002, -1.1199, -37.4282, 249.4726,-535.5305, 376.2721
3,0.0000, 0.0000,
0.0000,0.0000,0.0000 /c
tar = ta/trccall a03cal( a(0),b(0,1),c(0,1),d(0,1),e(0,1),tar )ak1 = a(0)+a(1)*amm+a(2)*amm**2.+a(3)*amm**3.
ccall a03cal( a(0),b(0,2),c(0,2),d(0,2),e(0,2),tar )ak2 = a(0)*exp(a(1)*amm+a(2)*amm**2.)ccall a03cal( a(0),b(0,3),c(0,3),d(0,3),e(0,3),tar )ap1 = a(0)+a(1)*amm+a(2)*amm**2.+a(3)*amm**3.
ccall a03cal( a(0),b(0,4),c(0,4),d(0,4),e(0,4),tar )ap2 = a(0)+a(1)*amm+a(2)*amm**2.
creturnendcc-----------------------------------------------subroutine a03cal( a,b,c,d,e,tar )cimplicit double precision (a-h,o-z)
dimension a(0:3),b(0:4),c(0:4),d(0:4),e(0:4)ca(0) = b(0)+b(1)*tar+b(2)*tar**2.+b(3)*tar**3.+b(4)*tar**4.
a(1) = c(0)+c(1)*tar+c(2)*tar**2.+c(3)*tar**3.+c(4)*tar**4.
a(2) = d(0)+d(1)*tar+d(2)*tar**2.+d(3)*tar**3.+d(4)*tar**4.
a(3) = e(0)+e(1)*tar+e(2)*tar**2.+e(3)*tar**3.+e(4)*tar**4.
c
returnendcc-----------------------------------------------c***** ニュートン法による最適化手法c***** 成分回帰分析法によるモデル定数補正値算定
ページ(17)

14-2programl.for.txt
csubroutine momreg(n1,n,m1,md,x,dpa)
component regression method
compute the correction terms of parameters (dpa)
dimension x(m1,n1),dpa(1),cov(9,9),g(200,9),y(200,9)
dimension binv(9,9),coe(9),st(9)na=n-1c**compute covariance matrix
call sqcov(n1,na,m1,md,x,cov)
do 50 i=1,na
50 st(i)=sqrt(cov(i,i))
do 52 i=1,na
s=st(i)do 52 j=1,i
s1=st(j)cov(i,j)=cov(i,j)/(s*s1)
52 cov(j,i)=cov(i,j)
c**factorization of cov(i,j) by lower triangularc**cholesky method (cov = l * u)c**l = lower triangular u = upper triangularc**compute the inverse of u(i,j)
call lowtri(n1,na,cov,binv)
do 54 j=1,na
s=st(j)do 54 i=1,md
54 y(i,j)=x(i,j)/s
do 20 i=1,md
do 20 j=1,na
s=0.
do 22 k=1,j
22 s=s+y(i,k)*binv(k,j)
20 g(i,j)=s
do 24 i=1,na
s=0.0
do 26 j=1,md
26 s=s+g(j,i)*x(j,n)
24 coe(i)=s
do 30 i=1,na
s=0.
do 29 j=i,na
29 s=s+binv(i,j)*coe(j)30 dpa(i)=s/st(i)returnendcc-----------------------------------------------subroutine lowtri(n1,n,p,binv)c**lower triangular cholesky factorizationc**p = u*bc**p = symmetric matrixc**u = lower triangular matrixc**b = upper triangular matrix (b = ut)c**binv = inverse matrix of bc**
= upper triangular matrix
c**compute lower triangular u(i,j)
dimension p(n1,n1),binv(n1,n1)
dimension u(9,9),b(9,9)
c
c**
c**

ページ(18)

14-2programl.for.txt
do 5 j=1,n-1u(j,j)=abs(p(j,j))u(j,j)=sqrt(u(j,j))al=1./u(j,j)
do 5 k=n,j+1,-1u(k,j)=al*p(k,j)
be=u(k,j)
do 5 i=k,n5 p(i,k)=p(i,k)-u(i,j)*beu(n,n)=abs(p(n,n))u(n,n)=sqrt(u(n,n))cc**b = transpose of u
do 40 i=1,ndo 40 j=i,n40 b(i,j)=u(j,i)

cc**compute inverse of b(i,j)
binv(1,1)=1./b(1,1)
do 50 j=2,nbinv(j,j)=1./b(j,j)
jm1=j-1
do 50 k=1,jm1
sum=0.0
do 52 i=k,jm1
52 sum = sum - binv(k,i)*b(i,j)
50 binv(k,j)=sum*binv(j,j)
returnendcc-----------------------------------------------subroutine sqcov(n1,n,m1,md,x,cov)c**compute covariance matrix
dimension x(m1,n1),cov(n1,n1)
do 10 i=1,ndo 10 j=1,is=0.
do 12 k=1,md
12 s=s+x(k,i)*x(k,j)
10 cov(i,j)=s
returnend

ページ(19)

input_1.txt
湧別川
湧別川
丸瀬布
２００１年９月１２日洪水
23
10
50 0.001
0.014
10.0000.150
1.500
110 110
2001
9
10
10
6
2
0
0
0
0
1
0
10
11
10
0
河道Ａ
1
20500 1.3834 0.6765
河道Ｂ
27300 1.5532 0.6642
ＡＲＥＡ１
1 130.17
0.00
0.00
0.00
0.00
0.00
0.00
5.44
2.56
3.44
3.56
8.00
7.44
7.12
6.00
5.44
5.56
6.00
5.00
3.00
4.00
6.00
1.00
1.00
1.00
2.00
2.00
3.00
1.00
1.00
0.56
0.00
1.00
0.56
1.44
1.00
0.56
1.00
0.44
0.56
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ２
2 143.80
0.00
0.00
0.00
0.00
0.00
0.00
5.86
2.14
3.86
3.14
8.00
7.86
6.28
6.00
5.86
5.14
6.00
5.00
3.00
4.00
6.00
1.00
1.00
1.00
2.00
2.00
3.00
1.00
1.00
0.14
0.00
1.00
0.14
1.86
1.00
0.14
1.00
0.86
0.14
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ページ(1)

0.56

4.00

4.56

7.12

4.00

5.56

4.56

6.88

6.44

1.00

3.00

1.56

1.56

0.56

1.00

0.44

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.14

4.00

4.14

6.28

4.00

5.14

4.14

7.72

6.86

1.00

3.00

1.14

1.14

0.14

1.00

0.86

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

input_1.txt
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
ＡＲＥＡ３
3
82.94
0.00
0.00
3.67
2.23
2.63
5.59
4.65
5.88
6.66
1.42
1.30
1.00
1.35
1.00
1.42
1.24
1.00
0.00
0.30
0.05
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ４
4 280.31
0.00
0.00
3.32
2.15
2.83
6.00
5.34
5.16
6.51
1.51
1.00
1.00
1.00
0.66
1.51
0.66
1.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ５
5
44.18
0.00
0.00
1.66
1.34
2.07

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.30

0.18

0.00

1.00

4.05

3.97

3.51

8.30

7.26

7.18

7.26

4.43

5.51

5.70

4.89

3.47

4.00

5.35

6.07

6.07

1.12

2.35

2.47

3.00

1.42

2.63

2.37

0.42

1.30

1.00

1.49

2.23

1.37

1.35

0.42

1.00

0.35

0.00

0.42

0.00

0.07

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.30

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.50

0.00

0.66

4.00

2.64

2.65

8.00

7.85

5.30

5.31

5.01

4.65

6.00

5.00

3.51

4.00

4.66

7.18

6.84

1.50

2.00

2.51

3.00

1.51

2.49

2.16

0.51

1.00

0.66

2.35

1.16

1.16

1.00

0.85

0.66

0.00

0.00

0.85

0.00

0.50

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.60

0.47

0.00

1.00

4.07

2.26

2.66

8.60

7.80

5.53

5.85

5.27

4.66

0.00

ページ(2)

input_1.txt
5.27
4.34

5.60

5.41

4.86

4.07

4.00

5.66

6.34

6.34

1.59

1.40

2.66

3.07

3.00

2.00

2.07

2.93

1.00

1.00

1.59

1.00

2.34

2.26

1.93

1.66

1.00

1.00

1.00

0.66

0.00

1.00

0.00

0.34

0.07

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.60

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
0.00
ＡＲＥＡ６
6 120.60
0.00
0.00
0.00
3.19
1.80
2.79
3.40
5.00
4.40
5.61
5.79
6.42
1.60
1.21
1.39
1.00
1.60
1.00
0.60
1.60
0.81
1.00
0.60
0.00
0.21
0.39
0.00
0.00
0.00
0.00
0.21
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
丸瀬布地点流域平均雨量
0.00
0.00
0.00
4.05
2.12
3.05
3.09
5.77
5.18
5.38
5.90
6.39
1.36
1.10
1.27
1.00
1.16
0.65
0.36
1.36
0.68
1.00
0.71
0.00
0.10
0.07
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.21

0.79

0.00

1.00

4.39

3.40

8.21

6.42

7.98

6.61

4.21

5.40

4.21

4.00

4.00

5.60

6.00

6.00

2.60

3.00

3.00

1.60

2.79

2.21

1.21

1.00

1.60

2.21

1.21

1.60

1.00

0.60

0.00

0.60

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.10

0.34

0.00

0.65

4.07

3.45

8.10

7.51

6.38

6.20

4.50

5.09

4.86

3.43

4.00

4.82

6.89

6.55

2.16

2.43

3.00

1.36

2.70

1.95

1.10

0.65

1.19

1.55

0.95

1.16

0.65

0.16

0.00

0.71

0.00

0.20

0.00

0.00

0.00

0.00

0.00

0.00

7.53
2.00
1.00
1.66
2.00
1.53
0.00
0.60
0.00
0.00
0.00
0.00
0.00
0.00
0.00

ページ(3)

0.00

input_1.txt
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
0.00
丸瀬布地点実績流量
9.09
9.09
9.09
10.69
12.43
16.30
18.86
259.08275.79 287.79 305.39
510.10554.89 609.12 621.79
503.48473.50 462.21 442.24
337.39333.57 325.99 322.23
265.07251.65 258.31 233.77
199.98202.94 194.12 197.04
163.45162.12 164.79 156.84
141.55142.80 134.20 129.41
111.11
107.83 104.61 102.48
90.20

0.00

0.00

0.00

0.00

0.00

0.00

8.78

8.78

9.09

9.09

9.40

9.72

43.45

66.84

102.36149.14203.24233.43336.51

371.10413.59441.05456.20480.53645.81627.38609.21588.78553.86524.78416.29403.62391.13374.80360.79345.10311.09294.74289.39273.63277.10271.91225.86224.29211.96202.94207.43197.04194.12189.78188.35178.45177.06171.55150.38155.54151.66145.30152.95142.80130.60125.87

124.70120.08111.11115.55102.48101.43

98.30

97.27

95.22

93.19

0.00
0.00
0.00
0.00
0.00

ページ(4)

input_2.txt
湧別川
湧別川
開盛
２００１年９月１２日洪水
23
10
50 0.001
0.014
10.0000.150
1.500
110 110
2001
9
10
10
8
5
1
0
1
0
0
1
0
1
河道Ｃ
3
10400 1.6246 0.7030
河道Ｄ
4
10000 1.7880 0.7457
河道Ｅ
52700 2.5811 0.7057
河道Ｆ
618200 0.6202 0.8894
河道Ｇ
73800 1.5965 0.8186
丸瀬布地点実績流量802.00
9.09
9.09
9.09
8.78
10.69
12.43
16.30
18.86
43.45
259.08275.79 287.79 305.39 336.51
510.10554.89 609.12 621.79 645.81
503.48473.50 462.21 442.24 416.29
337.39333.57 325.99 322.23 311.09
265.07251.65 258.31 233.77 225.86
199.98202.94 194.12 197.04 194.12
163.45162.12 164.79 156.84 150.38
141.55142.80 134.20 129.41 130.60
111.11
107.83 104.61 102.48 102.48
90.20
ＡＲＥＡ７
7
71.50
0.01
0.00
0.00
0.00
1.99
1.01
2.99
2.99
7.99
4.01
4.00
5.01
6.00
3.02
6.02
2.01
1.02
1.99
3.00
1.00
2.00
1.01
1.01
1.00
1.99
0.02
1.01
1.01
1.01

0

10

11

10

1

0

0

8.78

9.09

9.09

9.40

9.72

66.84

102.36149.14203.24233.43371.10413.59441.05456.20480.53627.38609.21588.78553.86524.78403.62391.13374.80360.79345.10294.74289.39273.63277.10271.91224.29211.96202.94207.43197.04189.78188.35178.45177.06171.55155.54151.66145.30152.95142.80125.87

124.70120.08111.11115.55101.43

98.30

97.27

95.22

93.19

1.98

0.00

1.00

4.99

2.02

5.02

8.97

5.00

4.00

4.99

4.99

4.01

5.99

6.01

5.99

4.00

3.00

2.00

3.00

2.00

1.01

2.00

2.02

1.02

2.01

1.00

0.01

1.00

0.01

0.00

ページ(1)

input_2.txt
0.01
0.01

0.99

0.01

0.00

0.00

0.00

0.01

0.00

0.01

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
ＡＲＥＡ８
8
47.40
0.10
0.00
1.44
1.43
1.89
5.18
4.46
5.78
7.63
2.10
1.75
1.26
1.80
1.23
1.77
1.37
1.10
0.10
0.52
0.15
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ９
9
37.20
0.94
0.00
1.06
1.94
2.06
4.94
4.00
5.94
7.88
2.94
2.88
1.00
2.00
1.94
1.06
1.88
1.94
0.94
0.94
0.06
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.42

0.50

0.00

1.13

4.53

2.42

2.44

7.45

7.32

5.43

5.27

4.82

4.44

5.71

4.96

4.28

4.23

5.57

6.56

6.49

1.48

2.67

3.25

3.13

2.38

2.38

2.88

1.10

1.42

1.20

2.20

2.42

2.08

1.90

1.10

1.10

0.80

0.10

1.00

0.23

0.20

0.23

0.00

0.00

0.00

0.10

0.00

0.10

0.42

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.12

0.00

1.00

4.06

3.88

2.06

6.12

6.88

5.24

4.06

4.00

4.06

6.00

4.88

4.06

4.94

5.06

6.94

5.06

1.06

3.00

4.00

3.00

2.00

3.00

2.00

1.94

1.00

2.88

2.00

3.88

2.88

2.94

1.94

1.94

1.00

0.94

1.00

0.94

0.00

0.94

0.00

0.00

0.00

0.94

0.00

0.94

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
0.00
0.00
0.00
0.00

ページ(2)

input_2.txt
0.00
ＡＲＥＡ１０
10
10.44
1.00
0.00
1.00
2.00
2.00
5.00
4.00
6.00
8.00
3.00
3.00
1.00
2.00
2.00
1.00
2.00
2.00
1.00
1.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ１１
11 169.59
0.00
0.00
0.17
2.00
0.34
6.00
5.83
6.66
8.66
2.00
1.83
2.66
1.83
1.83
1.17
1.00
1.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ１２12 110.81
0.53
0.00
0.53
2.00
1.06
5.47
4.94
6.47
8.47
2.53
2.53

0.00

0.00

0.00

0.00

1.00

4.00

4.00

2.00

6.00

7.00

5.00

4.00

4.00

4.00

6.00

5.00

4.00

5.00

5.00

7.00

5.00

1.00

3.00

4.00

3.00

2.00

3.00

2.00

2.00

1.00

3.00

2.00

4.00

3.00

3.00

2.00

2.00

1.00

1.00

1.00

1.00

0.00

1.00

0.00

0.00

0.00

1.00

0.00

1.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.17

0.00

1.83

6.50

1.83

1.17

3.01

7.17

2.34

3.17

4.34

3.17

6.83

6.66

4.83

4.83

5.00

7.83

8.66

2.00

2.00

3.00

3.83

4.50

2.83

3.83

1.00

1.00

1.00

2.17

1.83

2.83

1.83

1.00

1.00

0.83

0.00

1.00

0.83

0.17

0.83

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

1.47

5.41

3.06

1.53

4.12

7.00

3.59

3.53

4.00

3.53

6.47

5.94

4.47

5.00

5.00

7.47

6.88

1.47

2.53

3.53

3.47

3.41

3.00

2.94

ページ(3)

input_2.txt
1.94
2.00

2.00

1.53

1.00

2.06

2.00

3.06

3.00

2.53

1.53

1.53

1.53

1.00

0.53

1.00

1.00

0.00

0.00

1.00

0.00

0.00

0.00

0.53

0.00

0.53

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
ＡＲＥＡ１３
13
13.76
1.00
0.00
1.00
2.00
2.00
5.00
4.00
6.00
8.00
3.00
3.00
1.00
2.00
2.00
1.00
2.00
2.00
1.00
1.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ１４
14
72.10
0.71
0.00
1.29
1.71
2.29
4.71
4.00
5.71
7.41
2.71
2.41
1.00
2.00
1.71
1.29
1.41
1.71
0.71
0.71
0.29
0.00
0.00
0.00
0.00
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

1.00

4.00

4.00

2.00

6.00

7.00

5.00

4.00

4.00

4.00

6.00

5.00

4.00

5.00

5.00

7.00

5.00

1.00

3.00

4.00

3.00

2.00

3.00

2.00

2.00

1.00

3.00

2.00

4.00

3.00

3.00

2.00

2.00

1.00

1.00

1.00

1.00

0.00

1.00

0.00

0.00

0.00

1.00

0.00

1.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.59

0.00

1.00

4.29

3.41

2.29

6.59

6.41

6.18

4.29

4.00

4.29

6.00

4.41

4.29

4.71

5.29

6.71

5.29

1.29

3.00

4.00

3.00

2.00

3.00

2.00

1.71

1.00

2.41

2.00

3.41

2.41

2.71

1.71

1.71

1.00

0.71

1.00

0.71

0.00

0.71

0.00

0.00

0.00

0.71

0.00

0.71

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

1.00
1.53
0.53
0.53
0.00
0.00
0.00
0.00
0.00
0.00
0.00

ページ(4)

input_2.txt
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
0.00
0.00
開盛地点流域平均雨量(7-14流域)
0.3276 0.0000 0.0000 0.0374
0.85351.7730 1.4426 1.8535 5.1416
5.25584.8189 6.1120 6.3361 5.3664
7.92102.3276 2.0647 1.6350 2.5546
1.74701.9281 1.7011 1.3276 1.0374
1.29891.1740 1.3276 1.3276 1.3276
0.32760.3650 0.1896 0.7011 0.0000
0.00000.0000 0.0000 0.0374 0.0000
0.00000.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000
0.0000
開盛地点実績流量
48.20
48.20
45.63
45.63
56.33
62.10
66.77
72.60
78.68
219.24291.50 341.30 377.81 419.76
765.50824.74 917.74 971.56 1004.58
881.33875.96 823.21 797.44 777.13
660.73656.09 637.67 619.52 615.02
507.91495.75 475.80 464.03 448.56
382.92378.60 370.02 365.76 359.43
326.59322.59 316.64 312.71 304.92
285.87282.13 275.54 268.43 254.49
208.62
196.35 190.35 184.45 172.93
145.74

0.00

0.00

0.00

0.00

0.00

0.45250.00001.37355.31242.61936.72874.60753.92874.1812

3.85354.56314.70115.22707.14656.86483.51723.3735

3.12282.89072.85631.65252.07192.61932.51012.25570.92810.32761.00000.70110.07190.00000.00000.32760.00000.32760.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.0000

45.63

45.63

45.63

45.63

50.84

87.59

108.30118.71137.68174.25471.49514.24571.34640.27708.46958.17958.17952.57919.35886.71742.20722.61

688.95684.20665.40597.20579.63562.33549.53532.68437.13418.41

407.38396.49392.90353.15344.87338.72334.65330.61302.99299.14295.32291.52287.74247.65234.27227.72221.26214.89172.93167.30161.77156.34150.990.00

ページ(5)

14-3program.for.txt
c ********************************************************
c 第14回ゼミc
複合流域における貯留関数法の最適化
c
地下水流出を含む貯留関数法
cc 作成者 星 清、松木賢治
作成日 2005.7.19
c ********************************************************
cc
分割流域流出計算手法：地下水流出成分を含む貯留関数法
c(2段タンク型非線形貯留関数モデル) のパラメータ同定c
支川に分割流域と河道追跡を含む計算を考慮
c
河道追跡は無次元領域にて計算した後、解を実領域に変換cc
上流端条件を考慮した河道追跡が可能
c(subroutine inputのnindで制御)cc***
モデル定数 c11, c12及びc13の同時最適化***
cc
一階ニュートン法（newton method）c
ヤコビアン(jacobian)行列（一次微係数使用）
c*************************************************************cc***surface-subsurface runoff componentcs1 = k11*q1**p1 + k12*d(q1**p2)/dtc
ds1/dt = r-q1-bcq1 = surface-subsurface runoff componentcb = k13*q1 (b = 地下水成分への浸透供給量)ck11 = c11*A**(0.24)ck12 = c12*k11**2*(rave)**(-0.2648)cc13 = 1 + k13cp1 = 0.6 and p2 = 0.4648
cc***groundwater flow componentcs2 = k21*q2 + k22*d(q2)/dtc
ds2/dt = b - q2cq2 = groundwater flow componentck21 = c1*k22c
k22 = k13/c0cc0 = (delta/tc)**2c
c1 = delta**2/tccc***q = q1 + q2 (total runoff)ccc
地下水成分分離に必要な定数ccdelta：減衰係数（δ＞２）
cdelta(δ) = 減衰係数（非振動解条件）cδ= 2.1 を使用
ctc：地下水流出成分の分離時定数ctc : ハイドログラフ低減部の減衰係数(λ：ramda)の逆数
cc***
入力条件 ；r= 観測雨量 ；q= 観測流量cc***********************************************************
coptimization of parameters c11, c12 and c13
c***********************************************************c-----------------------------------------------------character gp*128,chitenr*128,chiten1*128,chitenl*128
ページ(1)

14-3program.for.txt
cdimension q(200),pas(200,9),dpa(9)dimension x(9),u(18),er(200),z(9),co(9)dimension qc(200),uua(3,200),qqt(200),qinlt(200,20)
dimension rave(50),qb(50),qb0(50),uut(18),ut(18,200,20)
dimension dlqt(5,200,20),dlut(5,18,200,20),dlqbt(5)ccommon/st1/wk1,wk2,wp1,wp2,wc3,wk21,wk22,rain
common/st2/n,m,m1,m2,h,h2,h3,h4
common/date/iy,im,id,ih,nq,nr,nban
common/discha/r(50,200),q0(200),qt(200,20),area(50)common/st3/nl,kount,p,ncal,nind,ndat
common/st4/cc1,cc2,cc3,cp1,cp2,delta,tc,areatot,trave,areaj
common/st5/jdg(90),chitenl(10),cleg(40),alph(40),cmm(40)common/st6/qinl(200),chitenr(20),chiten1
common/st7/c00,c01copen(1,file='input2.dat',status='unknown')
open(5,file='河道追跡2.out',status='unknown')ccwrite(5,*)'分割流域流出・河道追跡を含む複合流域解析'
write(5,*)'地下水流出成分を含む貯留関数法'
write(5,*)'全流出量の感度係数を用いた'
write(5,*)'2段タンク型非線形貯留関数モデルの最適化'
write(5,*)'一階ニュートン法(一次微係数使用)'
write(5,*)'モデル定数 c11, c12及びc13の同時最適化'
write(5,'()')
c
c
c

データ入力
****************************************
call inputc****************************************
c
分割流域別初期流量及び基底流出成分の計算
areatot=0.0
do j=1,nban
areatot=areatot+area(j)end doareatot=areatot+areaj!上流端流域面積を追加
do j=1,nban
qb0(j)=q0(1)*area(j)/areatot
qb(j)=3.6*qb0(j)/area(j)end doc
基準点流量を流出高変換(mm/h)
do 1001 i=1,nq
1001 q(i)=3.6*q0(i)/areatotcc
分割流域における平均雨量強度の計算
do j=1,nban
rtot=0.0
nrt=0
do i=1,nr
if(r(j,i).gt.0.0) thenrtot=rtot+r(j,i)
nrt=nrt+1
end ifend dorave(j)=rtot/float(nrt)
ページ(2)

14-3program.for.txt
end doccc

基準点での平均流域雨量強度
trave = 基準点平均雨量強度
nzero=0
rtot=0.0
do 199 i=1,nr
if(r(nban+1,i).eq.0.0) go to 199
nzero=nzero+1
rtot=rtot+r(nban+1,i)
199 continue
xnz=nzero
trave=rtot/xnz

cwrite(5,'()')
write(5,210)
210 format('
流域面積',' 平均雨量強度',' c11初期値','& 'c13初期値')
write(5,'(2f10.2,3f13.3)') areatot,trave,cc1,cc2,cc3
c
c
c

cc

c
cc
c

規準化パラメータの設定
yc1=1.0
yc2=1.0
yc3=1.0モデル定数の初期値
co(1)=cc1
co(2)=cc2
co(3)=cc3
地下水流出成分（2段目タンク）の定数設定
c0,c1の計算
c00=(delta/tc)**2
c01=delta**2/tccwrite(5,'()')
write(5,'()')
gp='
No
c11
c12
&'
rmse
kai2'
write(5,'(a80)') gp

c13'//cdt=3600.0
xnl=nlm1=m+1m2=2*mxnq=nqfac=0.0ccc

上流端河道流入量を分割数(nl)ごとに設定
do i=1,nq
do k=1,nlif(i.eq.1) thenqinlt(i,k)=qinl(i)elseqinlt(i,k)=qinl(i-1)+float(k)*(qinl(i)-qinl(i-1))/xnl
end ifend doページ(3)

c12初期値',

14-3program.for.txt
end doccc

最適化開始 （一階ニュートン法）
do 999 kkll=1,kount

c
ibn=0
icn=0
do ll=1,nq
do i=1,nlif(nind.eq.0) thenqt(ll,i)=0.0
else
qt(ll,i)=qinlt(ll,i)
end ifut(1,ll,i)=0.0
ut(2,ll,i)=0.0
ut(3,ll,i)=0.0
end docqqt(ll)=qt(ll,nl)c
end doqbt=0.0
iscl=0
jscl=0c
do 900 nnl=1,ndat
jdg=1；河道追跡計算、jdg=0；分割流域流出計算
jjdg=jdg(nnl)
kscl=jjdg/10c
支川合流判断if(jscl.eq.0.and.kscl.eq.0) go to 906
if(kscl.ne.0) go to 907c
本川へ合流、保存量（上流端流量）全てを合計して下流へ
do kkl=1,jscl
do ll=1,nq
do i=1,nl
qt(ll,i)=qt(ll,i)+dlqt(kkl,ll,i)do j=1,3
ut(j,ll,i)=ut(j,ll,i)+dlut(kkl,j,ll,i)end doend doqqt(ll)=qqt(ll)+dlqt(kkl,ll,nl)
end doqbt=qbt+dlqbt(kkl)
end dojscl=0
iscl=0c** 支川合流点で下流に河道も流域もない場合
if(jjdg.eq.2) go to 905
go to 906
907 if(kscl-iscl) 902,906,904c
支川合流終了、同じ支川に分割流域・河道が結合、c
支川から新たな支川発生
902 if(jscl.le.1) stopc
合流支川部に保存量（上流端流量）を加える
do ll=1,nqc

ページ(4)

14-3program.for.txt
do i=1,nl
qt(ll,i)=qt(ll,i)+dlqt(jscl,ll,i)do j=1,3
ut(j,ll,i)=ut(j,ll,i)+dlut(jscl,j,ll,i)end doend doqqt(ll)=qqt(ll)+dlqt(jscl,ll,nl)
end doqbt=qbt+dlqbt(jscl)
jscl=jscl-1
iscl=kscl
go to 906
904 jscl=jscl+1c
新たな支川が発生、ランク（jscl）を加え、
c
支川番号(iscl）を保存するc
今まで累加した量を保存し、流出量等をクリアする
iscl=kscl
do ll=1,nq
do i=1,nldlqt(jscl,ll,i)=qt(ll,i)qt(ll,i)=0.
do j=1,3dlut(jscl,j,ll,i)=ut(j,ll,i)ut(j,ll,i)=0.
end doend dodlqt(jscl,ll,nl)=qqt(ll)qqt(ll)=0.
end dodlqbt(jscl)=qbt
qbt=0.
906 jjdg=jjdg-kscl*10c
分割流域か河道かの判断cif(jjdg.eq.1) go to 901cc
分割流域における流出計算.........
c
ibn:河道番号c
ibn=ibn+1c
分割流域での流出計算時間間隔
h=1./xnl
h2=h*hh3=h2*hh4=h3*hcc***
モデル定数の更新cc
表面・中間流出成分(1段目タンク)の定数c
貯留関数モデル定数 k11, k12, p1, p2の設定
wk1=cc1*yc1*area(ibn)**0.24
zk2=cc2*yc2*wk1**2*rave(ibn)**(-0.2648)
wk2=1./zk2
wp1=cp1
zp2=cp2
wp2=1./zp2
wc3=cc3*yc3cページ(5)

14-3program.for.txt
地下水流出成分(2段目タンク)の貯留係数
zk22=(wc3-1.0)/c00
wk22=1.0/zk22
wk21=c01*zk22ccc

流量と感度係数の初期値設定
do 800 i=1,2*n
800 x(i)=0.0
x(1)=qb(ibn)**zp2
do 802 i=1,2*m2
802 u(i)=0.0cc**

do 30 ll=1,nq
rain=0.0
if(ll.le.nr) rain=r(ibn,ll)
do 40 k=1,nl
solution of sensitivity equation
call gesto(x,u,1)
solution of differential equation
call gesto(x,u,2)
if(x(1).le.0.0) x(1)=0.0
if(x(3).le.0.0) x(3)=0.0

c**

c
c

c
c
c
c

全流出高(計算流出高)
qcc=x(1)**wp2+x(3)cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)
流域流出量の累計（次の河道への流入量）
流域流出量の感度係数ベクトルの累計（次の河道へ伝達）
qt(ll,k)=qt(ll,k)+qcc*area(ibn)/3.6
ut(1,ll,k)=ut(1,ll,k)+area(ibn)/3.6*(cc*u(1)+u(7))& *area(ibn)**0.24
ut(2,ll,k)=ut(2,ll,k)+area(ibn)/3.6*(cc*u(2)+u(8))*wk1**2& *rave(ibn)**(-0.2648)
ut(3,ll,k)=ut(3,ll,k)+area(ibn)/3.6*(cc*u(3)+u(9))
40 continueccqc(ll)=qcc
qqt(ll)=qt(ll,nl)
qbt=qbt+qb0(ibn)
表面・中間流出成分と地下水流出成分の感度係数を合計
uua(1,ll)=(cc*u(1)+u(7))*area(ibn)**0.24
uua(2,ll)=(cc*u(2)+u(8))*wk1**2*rave(ibn)**(-0.2648)
uua(3,ll)=cc*u(3)+u(9)

c
c
c
c
c
c
c
c

qt:分割流域からの流出量（次の河道流入量）（累計）（計算時間間隔毎）
qqt:分割流域からの流出量（次の河道流入量）（累計）（１時間毎）チェック用
ut:分割流域の感度係数（累計）（計算時間間隔毎）
qbt:流域毎の初期流量の合計
uua:感度係数ベクトル（１時間毎）チェック用
30 continuecgo to 905
901 continue
ページ(6)

14-3program.for.txt
c
c
c
c
c
c
c
c
c

河道追跡計算（無次元領域）........................
icn=icn+1
ta,trの抽出 ......................................
call tatrst( nq,qqt,ts,ta,tr )ta/tr=0.5と仮定しても実用上問題なし
ta = tr*0.5
河道追跡用貯留関数モデル定数 k3,k4,p3,p4を計算....
amm=cmm(icn)
無次元領域での貯留関数モデル定数 k3,k4,p3,p4
call kpxcal( amm,ta,tr,wk1,wk02,wp1,wp02 )c
totq = 0.0
ncalgt = 0
do i = nint(ts),nint(ts+tr)
totq = totq+qqt(i)ncalgt = ncalgt+1
end do
c
c
c
c
c
c

c

上流端平均流入量(qm)qm = totq/float(ncalgt)
時間規準化(t* = ttt)
ttt = alph(icn)*cleg(icn)*qm**(cmm(icn)-1.0)
河道追跡用貯留関数モデル定数の保存
wk3=wk1
zk4=wk02
wp3=wp1
zp4=wp02
河道追跡における無次元計算時間間隔(h)h=dt/ttt/xnl
h2=h*hh3=h2*hh4=h3*hcc

河道追跡計算のための貯留関数モデル定数の変数変換
wk1=wk3zk2=zk4
wk2=1./zk2
wp1=wp3
zp2=zp4
wp2=1./zp2c
河道流量と感度係数の初期値設定
do 804 i=1,n804 x(i)=0.0
x(1)=(qt(1,1)/qm)**zp2
do 806 i=1,m2
806 u(i)=0.0c
do 31 ll=1,nq
do 41 k=1,nl
rain=qt(ll,k)/qmc
無次元量へ変換c
強制項（＝上流端流入量に関する感度係数）
ページ(7)

14-3program.for.txt
uut(1)=ut(1,ll,k)/qm
uut(2)=ut(2,ll,k)/qm
uut(3)=ut(3,ll,k)/qmc**solution of sensitivity equation
call gesto2(x,u,uut,1)c**solution of differential equation
call gesto2(x,u,uut,2)
if(x(1).le.0.0) x(1)=0.0
qcc=0.0
if(x(1).gt.0.0) qcc=x(1)**wp2
cc=0.0if(x(1).gt.0.0) cc=wp2*x(1)**(wp2-1.)c
実領域での流出量と感度係数へ変換
qt(ll,k)=qcc*qm
ut(1,ll,k)=cc*u(1)*qm
ut(2,ll,k)=cc*u(2)*qm
ut(3,ll,k)=cc*u(3)*qm
41 continuecqqt(ll)=qt(ll,nl)
31 continuec
905 continuec
900 continuecc
目的関数(sum):カイ2乗(skai2):相対誤差(sotai)
sum=0.0
skai2=0.0
sotai=0.0c
do 32 ll=1,nq
qq=q0(ll)qs=0.0if(qq.gt.0.0) qs=sqrt(qq)c
誤差項
err=qq-qt(ll,nl)er(ll)=err
if(qq.eq.0.0) go to 49
erw=(err/qs)*(3.6/areatot)**0.5
skai2=skai2+erw**2
sotai=sotai+abs(err)/qq
49 continue
sum=sum+(err*3.6/areatot)**2cc
１時間毎の感度係数ベクトル抽出
c**sensitivity coefficientsdo 42 i=1,m42 pas(ll,i)=ut(i,ll,nl)c
感度係数の規準化
do 43 i=1,m
43 pas(ll,i)=co(i)*pas(ll,i)cc**error between observed and computed dischargespas(ll,m1)=err
32 continuecsum=sqrt(sum/xnq)!rmse
ページ(8)

skai2=skai2/xnq

14-3program.for.txt!kai2

cwrite(5,'(i5,3f8.3,2f10.3)') kkll,cc1*yc1,cc2*yc2,wc3,& sum,skai2cz(1)=yc1z(2)=yc2z(3)=yc3
c
c
c
c**
c**

ニュートン法によるモデル定数補正値計算（成分回帰分析法の利用）
component regression method
to solve the correction terms of parameterscall momreg(9,m1,200,nq,pas,dpa)
do 875 i=1,m
col = abs(dpa(i)/z(i))
if(col.gt.p) go to 877
875 continue
go to 879
877 fac = 0.5*(1.+fac)
do 878 i=1,mdpa(i)=fac*dpa(i)878 continue
do 991 i=1,mxnew=z(i)+dpa(i)if(xnew.ge.0.001) z(i)=z(i)+dpa(i)991 continuecc
if(z(3)*cc3.lt.1.0) z(3)=1.0/cc3cc
yc1=z(1)yc2=z(2)yc3=z(3)999 continue
879 continueccrtot=0.0
qtot=0.0
qctot=0.0
qsotai=0.0
qsotai2=0.0
qsotai3=0.0
qmax=-999.99
qmaxc=-999.99
do 502 i=1,nqif(q0(i).gt.qmax) qmax=q0(i)!観測ピークif(qt(i,nl).gt.qmaxc) qmaxc=qt(i,nl) !計算ピーク
502 continue
iko=0.0
do 503 i=1,nq
rtot=rtot+r(nban+1,i)
qtot=qtot+q0(i)qctot=qctot+qt(i,nl)
if(q0(i).lt.0.04*areatot/3.6) go to 500
iko=iko+1
qsotai=qsotai+abs(q0(i)-qt(i,nl))/q0(i)qsotai2=qsotai2+((q0(i)-qt(i,nl))/q0(i))**2
ページ(9)

14-3program.for.txt
500 continue
qsotai3=qsotai3+((q0(i)-qt(i,nl))/qmax)**2
503 continue
xiko=ikoqtot0=3.6*qtot/areatot!観測流出高qctot0=3.6*qctot/areatot!計算流出高hiryu=qmax/areatot!比流量peakg=abs(qmax-qmaxc)/qmax!Jpe（ピーク相対誤差）
qsotai=qsotai/xiko!Jre（ハイドログラフ相対誤差）
qsotai2=qsotai2/xiko!Ewqsotai3=qsotai3/xnq!Eqsotai4=(qtot-qctot)/qtot!Evqsotai5=(qmax-qmaxc)/qmax!Epcc--OUTPUT 2
write(5,'()')
write(5,211)
211 format(2x,'収束回数',5x,'c11',9x,'c12',9x,'c13',&8x,'rmse',8x,'kai2',9x,'Jpe',9x,'Jre')write(5,'(i7,8f12.3)') kkll,cc1*yc1,cc2*yc2,wc3,&sum,skai2,peakg,qsotai
write(5,'()')
write(5,214)
214 format(7x,'Ew',9x,'E',8x,'Ev',8x,'Ep')
write(5,'(4f10.3)') qsotai2,qsotai3,qsotai4,qsotai5
write(5,'()')
write(5,212)
212 format(4x,'比流量',4x,'総雨量',2x,'観測総流出',3x,'計算総流出',3x,&'観測ピーク値',3x,'計算ピーク値')
write(5,'(3f10.3,4f15.3)') hiryu,rtot,qtot0,qctot0,qmax,qmaxc
write(5,'()')
cwrite(5,204)
204 format('NO',6x,'実測雨量',6x,'実測流出高',6x,'計算流出高')
do i=1,nq
write(5,207) i,r(nban+1,i),q(i),qt(i,nl)*3.6/areatot
end do207 format(i8,f12.2,2f16.4)
c
stop
end
c
c-----------------------------------------------c***** 流域流出解析と河道追跡のためのデータ入力
csubroutine inputccharacter suikei*128,kasen*128,chiten*128,kouzui*128,& gp*128,chitenr*128,chiten1*128,chitenl*128ccommon/st1/wk1,wk2,wp1,wp2,wc3,wk21,wk22,rain
common/st2/n,m,m1,m2,h,h2,h3,h4
common/date/iy,im,id,ih,nq,nr,nban
common/discha/r(50,200),q0(200),qt(200,20),area(50)common/st3/nl,kount,p,ncal,nind,ndat
common/st4/cc1,cc2,cc3,cp1,cp2,delta,tc,areatot,trave,areaj
common/st5/jdg(90),chitenl(10),cleg(40),alph(40),cmm(40)common/st6/qinl(200),chitenr(20),chiten1
ページ(10)14-3program.for.txt
c
c
c
c
c
c
c
c
c
c
c
c
c

データの読み込みn: 微分方程式階数（n=2)
m: モデル定数の数（m=3)
nl:１時間の計算分割数 (nl=10)
kount:最大繰り返し計算回数 (kount=20) p:収束条件 (p=0.001)
nban:流域数
ncal:河道数 nc2:下流に流域・河道がない合流点の数
nind=0; 上流端流入量なし nind=1;上流端流入量有り
jdg:流域、河道の計算判別、計算順序---0;流域 1;河道
cleg:河道長 alph:α cmm:ｍ area:流域面積
r:流域雨量 q0:基準点流量 qinl:上流端河道流入量
p1=0.6 p2=0.4648 delta=2.1！流出モデル定数
data cp1,cp2,delta/0.6,0.4648,2.1/

c

c
c
c
cc

c

c

c

c
c

read(1,3) suikei!水系名
read(1,3) kasen!河川名read(1,3) chiten!観測所名
read(1,3) kouzui!洪水年月日3 format(a128)
4 format(4i5,2f8.0)
5 format(3f8.0)
read(1,4) n,m,nl,kount,ptc：流出成分分離時定数
tc =ハイドログラフ低減部の減衰係数(ramda)の逆数
read(1,'(f8.0)') tc
初期値：c11,c12,c13
read(1,5) cc1,cc2,cc3
nr: 雨量データ数 nq: 流量データ数
read(1,'(2i5)') nr,nqread(1,'(4i5)') iy,im,id,ihread(1,'(4i5)') nban,ncal,nind,nc2
ndat=nban+ncal+nc2
read(1,'(20i5)') (jdg(i),i=1,ndat)
河道定数入力if(ncal.ge.1) thendo j=1,ncal
read(1,'(a40)') chitenl(j)read(1,'(i5,3f8.0)') no,cleg(j),alph(j),cmm(j)end doend ifnind=1; 上流端流入量がある場合の入力
if(nind.ge.1) thenread(1,'(a40)') gp
read(1,'(f8.0)') areaj!上流端流域面積を追加
read(1,'(10f8.0)') (qinl(i),i=1,nq)
write(5,'()')
write(5,*)'nind = 1 : 上流端流入量境界条件'
write(5,'(a40)') gp
end if
分割流域の面積と流域平均雨量の入力
do j=1,nban
read(1,'(a40)') chitenr(j)read(1,'(i5,f8.0)') no,area(j)read(1,'(10f8.0)') (r(j,i) ,i=1,nr)
end do
基準点における流域平均雨量入力
ページ(11)

14-3program.for.txtcread(1,'(a40)') gp
read(1,'(10f8.0)') (r(nban+1,i),i=1,nr)
c
c
c
c
c

基準点実測流量の入力(m3/sec)read(1,'(a40)') chiten1
read(1,'(10f8.0)') (q0(i),i=1,nq)
入力データ出力
write(5,'(''水系：'',a80)') suikei!水系
write(5,'(''河川名：'',a80)') kasen!河川名write(5,'(''観測地点：'',a80)') chiten!観測地点
write(5,'(''洪水年月日：'',a80)') kouzui!洪水年月日write(5,'(''洪水開始年月日時：'',4i5)') iy,im,id,ih
write(5,'()')
write(5,'('' 流量データ数=''i3,'' 計算時間間隔= 1/'',i2)') nq,nlwrite(5,'()')
write(5,'(''分離時定数(Tc) ='',f8.2)') tc
write(5,'()')
write(5,'(4i5)') nban,ncal,nind,nc2
write(5,'()')
write(5,'(20i5)') (jdg(i),i=1,ndat)creturnendcc-----------------------------------------------cc***** 分割流域における流出計算と感度係数算定*****c
表面・中間流出成分と地下水流出成分を同時に計算
csubroutine gesto(x,u,ijk)
c
c**
***
surface-subsurface runoff componentcs1 = k11*q1**p1 + k12*d(q1**p2)/dtc
ds1/dt = r-q1-bcq1 = surface-subsurface runoff componentcb = k13*q1 (b = 地下水成分への浸透供給量)ck11 = c11*A**(0.24)ck12 = c12*k11**2*(rave)**(-0.2648)cc13 = 1 + k13cp1 = 0.6 and p2 = 0.4648
cc***groundwater flow componentcs2 = k21*q2 + k22*d(q2)/dtc
ds2/dt = b - q2cq2 = groundwater flow componentck21 = c1*k22c
k22 = k13/c0cc0 = (delta/tc)**2c
c1 = delta**2/tccc***q = q1 + q2 (total runoff)ccdelta(δ) = 減衰係数（非振動解条件）cδ= 2.1 を使用
c
tc = 地下水成分分離時定数ctc : ハイドログラフ低減部の減衰係数(λ：ramda)の逆数
ページ(12)

14-3program.for.txt
c
c***
c
c**
c**
c**
c

入力条件

；r= 観測雨量；q= 観測流量x(k+1)= phi*x(k) + gamma*b(k)ijk = 1; solve sensitivity equation
ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18),b(9)common/st1/wk1,wk2,wp1,wp2,wc3,wk21,wk22,rain
common/st2/n,m,m1,m2,h,h2,h3,h4
common/st7/c00,c01ccon=wk1*wk2*wp1*wp2
wk13=wc3-1.0
a=0.0
c=0.0
d=0.0
e=0.0
c
１段目タンクの状態変量
y1=x(1)y2=x(2)c
２段目タンクの状態変量
y3=x(3)y4=x(4)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2c
１段目タンクの係数
14 a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c*wc3
a2=-con*da3=a1+a2**2
a4=a1+a3c
２段目タンクの係数
a5=-c00/wk13
a6=-c01
a7=a5+a6**2
a8=a5+a7c**elements of phi matrix (transition matrix)c**
１段タンク目のΦの値
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrixc**
１段タンク目のγの値
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
c**
elements of phi matrix (transition matrix)c**
２段タンク目のΦの値
f5 = 1. +0.5*a5*h2+a5*a6*h3/6.+a5*a7*h4/24.
f6 = h*(1. + 0.5*a6*h+a7*h2/6.+a6*a8*h3/24.)
f7 = a5*f6
f8 = 1. +a6*h+0.5*a7*h2+a6*a8*h3/6.+
ページ(13)

14-3program.for.txt(a5*a7+a6**2*a8)*h4/24.
elements of gamma matrix
２段タンク目のγの値
g6 = h2*(0.5+a6*h/6.+a7*h2/24.)
g8=f6

&
c**
c**
c

if(ijk.eq.2) go to 104
c
c**
c**
c

solve sensitivity equation
１段目タンクにおける感度係数の計算
感度方程式の強制項計算b(1)=-wk2*wp1*wp2*d*y2b(2)=wk2**2*(wk1*wp1*wp2*d*y2 + e*wc3 - rain)b(3)=-wk2*e
do 16 i=1,m
16 uu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
18 uu(i) = f3*u(i-m) + f4*u(i) + g4*b(i-m)
c**
２段目タンクにおける感度係数の計算
c
感度方程式の強制項計算
m3=m2+mb(4)=c00*wp2*c*u(1)b(5)=c00*wp2*c*u(2)b(6)=c00*wp2*c*u(3)+(c00/wk13**2)*y3
do 17 i=1,m
17 uu(i+m2)= f5*u(i+m2) + f6*u(i+m3) + g6*b(i+m)
do 19 i=m1,m2
19 uu(i+m2) = f7*u(i+m) + f8*u(i+m2) + g8*b(i)do 20 i=1,2*m2
20 u(i)=uu(i)creturn104 continuec**solve system equationcc**
１段目タンクの状態変量(y1,y2)の計算
b1=con*(wp1*wp2-1.)*d*y2+wk2*wc3*(wp2-1.)*e+wk2*rainy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1cc**
２段目タンクの状態変量(y3,y4)の計算
b2=c00*ey(3) = f5*x(3)+f6*x(4)+g6*b2
y(4) = f7*x(3)+f8*x(4)+g8*b2
do 102 i=1,2*n
102 x(i)=y(i)returnendcc-----------------------------------------------cc***** 河道追跡流量と感度係数の算定 *****c
数値解法は流域流出計算と同じ
c
subroutine gesto2(x,u,uut,ijk)cc**s = k1*q**p1 + k2*d(q**p2)/dtc**x(k+1)= phi*x(k) + gamma*b(k)c**ijk = 1; solve sensitivity equation
ページ(14)c**c14-3program.for.txt
ijk = 2; solve differential equation
dimension x(1),u(1),y(9),uu(18),b(9),uut(1)common/st1/wk1,wk2,wp1,wp2,wc3,wk21,wk22,rain
common/st2/n,m,m1,m2,h,h2,h3,h4c
con=wk1*wk2*wp1*wp2
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(1)y2=x(2)if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp1*wp2-2.)c=y1**(wp2-1.)
d=y1**(wp1*wp2-1.)e=y1**wp2
14 a1=-con*(wp1*wp2-1.)*a*y2-wk2*wp2*c
a2=-con*da3=a1+a2**2
a4=a1+a3c**elements of phi matrix (transition matrix)
f1 = 1. +0.5*a1*h2+a1*a2*h3/6.+a1*a3*h4/24.
f2 = h*(1. + 0.5*a2*h+a3*h2/6.+a2*a4*h3/24.)
f3 = a1*f2
f4 = 1. +a2*h+0.5*a3*h2+a2*a4*h3/6.+&(a1*a3+a2**2*a4)*h4/24.
c**elements of gamma matrix
g2 = h2*(0.5+a2*h/6.+a3*h2/24.)
g4=f2
if(ijk.eq.2) go to 104
c**solve sensitivity equationc
強制項（＝上流端流入量に関する感度係数）b(1)=wk2*uut(1)b(2)=wk2*uut(2)b(3)=wk2*uut(3)do 16 i=1,m
16 uu(i)= f1*u(i) + f2*u(i+m) + g2*b(i)do 18 i=m1,m2
18 uu(i) = f3*u(i-m) + f4*u(i) + g4*b(i-m)
do 20 i=1,m2
20 u(i)=uu(i)return104 continuec**solve system equation
b1=con*(wp1*wp2-1.)*d*y2+wk2*(wp2-1.)*e+wk2*rainy(1) = f1*x(1)+f2*x(2)+g2*b1
y(2) = f3*x(1)+f4*x(2)+g4*b1
do 102 i=1,n102 x(i)=y(i)returnendcc-----------------------------------------------c***** 洪水継続時間とピーク流量生起時刻の算定
ページ(15)

14-3program.for.txt
csubroutine tatrst( ncalx,qq,ts,ta,tr )dimension qq(1),qtot(0:720),xdt(720)cqtot(0) = 0.0
qmax= -9999.
do i = 1,ncalx
xdt(i) = float(i)qtot(i) = qtot(i-1)+qq(i)if( qq(i).ge.qmax ) thenqmax = qq(i)iqmx = i
end ifend docq25x = qmax*0.25
iq25 = 0
do i = 1,iqmx
if( qq(i).gt.q25x ) theniq25 = i-1
go to 100end ifend do100
if( iq25.eq.0 ) iq25 = iqmx
jq25 = 0
do i = ncalx,iqmx,-1
if( qq(i).gt.q25x ) then
jq25 = i+1
go to 200
end ifend do200
if( jq25.ge.ncalx ) jq25 = iqmxcrmin = 999.
its = 0do i = 2,iq25-1
call sokanl( xdt,qtot,1,i,r1 )call sokanl( xdt,qtot,i,iq25,r2 )r = (abs(1.-r1)+abs(1.-r2))*0.5
if( r.lt.rmin ) thenrmin = r
its = i
end ifend doif( its.eq.0 ) its = 1crmin = 999.
ite = 0do i = jq25+1,ncalx-1
if( i.eq.140 ) thenicv = 0end ifcall sokanl( xdt,qtot,i,ncalx,r1 )call sokanl( xdt,qtot,jq25,i,r2 )r = (abs(1.-r1)+abs(1.-r2))*0.5
if( r.lt.rmin ) thenrmin = rite = iページ(16)

14-3program.for.txt
end ifend doif( ite.eq.0 )ite = ncalx

c
ts
= 1.0
itsa = iqmx-its
if( itsa.gt.0 ) thena = (qmax-qq(its))/float(itsa)b = qq(its)-a*float(its)if( nint(a*1000.).eq.0 ) thents = 1.
else
ts = -b/aif( ts.le.0. ) ts = 1.
end ifta = float(iqmx)-ts
else
ta = 1.0
end ifitsa = iqmx-ite
if( itsa.lt.0 ) thena = (qmax-qq(ite))/float(itsa)b = qq(ite)-a*float(ite)if( nint(a*1000.).eq.0 ) thente = ncalx
else
te = -b/a
end if
tr = te-ts
if( tr.ge.ncalx ) tr = ncalx
else
tr = ncalx
end ifcreturnendcc-----------------------------------------------subroutine sokanl(x,y,n1,n2,r)dimensionx(1),y(1),xl(720),yl(720)cm = 0if( n1.lt.n2 ) thenn3 = 1else
n3 = -1
end ifdo i = n1,n2,n3
if(x(i).ge.0.0001 .and. y(i).ge.0.0001) thenm = m+1
xl(m) = x(i)yl(m) = y(i)end ifend doif( m.le.1 ) thena = 1.0
b = 0.0
r = 0.0
ページ(17)

14-3program.for.txt
elsecsumxy = 0.0
sumx = 0.0
sumy = 0.0
sumx2 = 0.0
sumy2 = 0.0
do i = 1,msumxy = sumxy+xl(i)*yl(i)sumx = sumx +xl(i)sumy = sumy +yl(i)sumx2 = sumx2+xl(i)*xl(i)sumy2 = sumy2+yl(i)*yl(i)end doczm=float(m)bunsi = sumxy-sumx*sumy/zm
bunbo = (sumx2-sumx*sumx/zm)*(sumy2-sumy*sumy/zm)
if( bunbo.gt.0.0 ) thenr
= bunsi/bunbo
else
r
= 1.0
end ifend ifcreturnendcc-----------------------------------------------c***** 河道追跡貯留関数モデル定数算定の近似式csubroutine kpxcal( amm,ta,tr,ak1,ak2,ap1,ap2 )cdimension a(0:3),b(0:4,4),c(0:4,4),d(0:4,4),e(0:4,4)
data b /0.8545, -4.8430, 33.8238, -72.2531, 49.7646
1,
0.2404, -1.1777,
8.0276, -16.2876,
9.80262,
0.5844, 0.9107, -32.9092, 96.5526, -80.2872
3, -0.3999, 10.4083, -47.3310, 71.7788, -31.9668 /data c /0.5229, 22.7545,-154.6917, 327.8772,-224.9687
1,
1.0848, 23.9708,-126.7464, 230.5159,-124.7640
2, -0.9989, -18.7643, 216.3786,-546.4481, 422.4272
3,
1.3325, -34.6802, 151.6250,-223.8849, 95.8506 /data d /-0.8426, -39.5757, 249.2689,-512.7692, 345.5463
1,
0.1929, -19.1466, 90.2282,-157.3522, 79.5772
2,
2.7263, 53.1813,-427.1458, 976.2463,-713.3760
3, -0.7202, 24.5035, -98.6764, 138.5036, -52.1388 /data e /0.2763, 22.4122,-130.0060, 259.4679,-171.6907
1,0.0000, 0.0000,
0.0000,0.0000,0.00002, -1.1199, -37.4282, 249.4726,-535.5305, 376.2721
3,0.0000, 0.0000,
0.0000,0.0000,0.0000 /c
tar = ta/trccall a03cal( a(0),b(0,1),c(0,1),d(0,1),e(0,1),tar )ak1 = a(0)+a(1)*amm+a(2)*amm**2.+a(3)*amm**3.
ccall a03cal( a(0),b(0,2),c(0,2),d(0,2),e(0,2),tar )ak2 = a(0)*exp(a(1)*amm+a(2)*amm**2.)
ページ(18)

14-3program.for.txt
ccall a03cal( a(0),b(0,3),c(0,3),d(0,3),e(0,3),tar )ap1 = a(0)+a(1)*amm+a(2)*amm**2.+a(3)*amm**3.
ccall a03cal( a(0),b(0,4),c(0,4),d(0,4),e(0,4),tar )ap2 = a(0)+a(1)*amm+a(2)*amm**2.
creturnendcc-----------------------------------------------subroutine a03cal( a,b,c,d,e,tar )cimplicit double precision (a-h,o-z)
dimension a(0:3),b(0:4),c(0:4),d(0:4),e(0:4)ca(0) = b(0)+b(1)*tar+b(2)*tar**2.+b(3)*tar**3.+b(4)*tar**4.
a(1) = c(0)+c(1)*tar+c(2)*tar**2.+c(3)*tar**3.+c(4)*tar**4.
a(2) = d(0)+d(1)*tar+d(2)*tar**2.+d(3)*tar**3.+d(4)*tar**4.
a(3) = e(0)+e(1)*tar+e(2)*tar**2.+e(3)*tar**3.+e(4)*tar**4.
c
returnendcc-----------------------------------------------c***** ニュートン法による最適化手法c***** 成分回帰分析法によるモデル定数補正値算定
csubroutine momreg(n1,n,m1,md,x,dpa)
c**component regression methodc**compute the correction terms of parameters (dpa)
dimension x(m1,n1),dpa(1),cov(9,9),g(200,9),y(200,9)
dimension binv(9,9),coe(9),st(9)na=n-1c**compute covariance matrix
call sqcov(n1,na,m1,md,x,cov)
do 50 i=1,na
50 st(i)=sqrt(cov(i,i))
do 52 i=1,na
s=st(i)do 52 j=1,i
s1=st(j)cov(i,j)=cov(i,j)/(s*s1)
52 cov(j,i)=cov(i,j)
c**factorization of cov(i,j) by lower triangularc**cholesky method (cov = l * u)c**l = lower triangular u = upper triangularc**compute the inverse of u(i,j)
call lowtri(n1,na,cov,binv)
do 54 j=1,na
s=st(j)do 54 i=1,md
54 y(i,j)=x(i,j)/s
do 20 i=1,md
do 20 j=1,na
s=0.
do 22 k=1,j
22 s=s+y(i,k)*binv(k,j)
20 g(i,j)=s
ページ(19)14-3program.for.txt
do 24 i=1,na
s=0.0
do 26 j=1,md
26 s=s+g(j,i)*x(j,n)
24 coe(i)=s
do 30 i=1,na
s=0.
do 29 j=i,na
29 s=s+binv(i,j)*coe(j)30 dpa(i)=s/st(i)returnendcc-----------------------------------------------subroutine lowtri(n1,n,p,binv)c**lower triangular cholesky factorizationc**p = u*bc**p = symmetric matrixc**u = lower triangular matrixc**b = upper triangular matrix (b = ut)c**binv = inverse matrix of bc**
= upper triangular matrix
c**compute lower triangular u(i,j)
dimension p(n1,n1),binv(n1,n1)
dimension u(9,9),b(9,9)
cdo 5 j=1,n-1u(j,j)=abs(p(j,j))u(j,j)=sqrt(u(j,j))al=1./u(j,j)
do 5 k=n,j+1,-1u(k,j)=al*p(k,j)
be=u(k,j)
do 5 i=k,n5 p(i,k)=p(i,k)-u(i,j)*beu(n,n)=abs(p(n,n))u(n,n)=sqrt(u(n,n))cc**b = transpose of u
do 40 i=1,ndo 40 j=i,n40 b(i,j)=u(j,i)
cc**compute inverse of b(i,j)
binv(1,1)=1./b(1,1)
do 50 j=2,nbinv(j,j)=1./b(j,j)
jm1=j-1
do 50 k=1,jm1
sum=0.0
do 52 i=k,jm1
52 sum = sum - binv(k,i)*b(i,j)
50 binv(k,j)=sum*binv(j,j)
returnendcc-----------------------------------------------subroutine sqcov(n1,n,m1,md,x,cov)
ページ(20)14-3program.for.txt
compute covariance matrix
dimension x(m1,n1),cov(n1,n1)
do 10 i=1,ndo 10 j=1,is=0.
do 12 k=1,md
12 s=s+x(k,i)*x(k,j)
10 cov(i,j)=s
returnendc**

ページ(21)

input2_1.txt
湧別川
湧別川
丸瀬布
２００１年９月１２日洪水
23
10
50 0.001
75.8
10.0000.150
1.500
110 110
2001
9
10
10
6
2
0
0
0
0
1
0
10
11
10
0
河道Ａ
1
20500 1.3834 0.6765
河道Ｂ
27300 1.5532 0.6642
ＡＲＥＡ１
1 130.17
0.00
0.00
0.00
0.00
0.00
0.00
5.44
2.56
3.44
3.56
8.00
7.44
7.12
6.00
5.44
5.56
6.00
5.00
3.00
4.00
6.00
1.00
1.00
1.00
2.00
2.00
3.00
1.00
1.00
0.56
0.00
1.00
0.56
1.44
1.00
0.56
1.00
0.44
0.56
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ２
2 143.80
0.00
0.00
0.00
0.00
0.00
0.00
5.86
2.14
3.86
3.14
8.00
7.86
6.28
6.00
5.86
5.14
6.00
5.00
3.00
4.00
6.00
1.00
1.00
1.00
2.00
2.00
3.00
1.00
1.00
0.14
0.00
1.00
0.14
1.86
1.00
0.14
1.00
0.86
0.14
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ページ(1)

0.56

4.00

4.56

7.12

4.00

5.56

4.56

6.88

6.44

1.00

3.00

1.56

1.56

0.56

1.00

0.44

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.14

4.00

4.14

6.28

4.00

5.14

4.14

7.72

6.86

1.00

3.00

1.14

1.14

0.14

1.00

0.86

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

input2_1.txt
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
ＡＲＥＡ３
3
82.94
0.00
0.00
3.67
2.23
2.63
5.59
4.65
5.88
6.66
1.42
1.30
1.00
1.35
1.00
1.42
1.24
1.00
0.00
0.30
0.05
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ４
4 280.31
0.00
0.00
3.32
2.15
2.83
6.00
5.34
5.16
6.51
1.51
1.00
1.00
1.00
0.66
1.51
0.66
1.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ５
5
44.18
0.00
0.00
1.66
1.34
2.07

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.30

0.18

0.00

1.00

4.05

3.97

3.51

8.30

7.26

7.18

7.26

4.43

5.51

5.70

4.89

3.47

4.00

5.35

6.07

6.07

1.12

2.35

2.47

3.00

1.42

2.63

2.37

0.42

1.30

1.00

1.49

2.23

1.37

1.35

0.42

1.00

0.35

0.00

0.42

0.00

0.07

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.30

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.50

0.00

0.66

4.00

2.64

2.65

8.00

7.85

5.30

5.31

5.01

4.65

6.00

5.00

3.51

4.00

4.66

7.18

6.84

1.50

2.00

2.51

3.00

1.51

2.49

2.16

0.51

1.00

0.66

2.35

1.16

1.16

1.00

0.85

0.66

0.00

0.00

0.85

0.00

0.50

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.60

0.47

0.00

1.00

4.07

2.26

2.66

8.60

7.80

5.53

5.85

5.27

4.66

0.00

ページ(2)

input2_1.txt
5.27
4.34

5.60

5.41

4.86

4.07

4.00

5.66

6.34

6.34

1.59

1.40

2.66

3.07

3.00

2.00

2.07

2.93

1.00

1.00

1.59

1.00

2.34

2.26

1.93

1.66

1.00

1.00

1.00

0.66

0.00

1.00

0.00

0.34

0.07

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.60

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
0.00
ＡＲＥＡ６
6 120.60
0.00
0.00
0.00
3.19
1.80
2.79
3.40
5.00
4.40
5.61
5.79
6.42
1.60
1.21
1.39
1.00
1.60
1.00
0.60
1.60
0.81
1.00
0.60
0.00
0.21
0.39
0.00
0.00
0.00
0.00
0.21
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
丸瀬布地点流域平均雨量
0.00
0.00
0.00
4.05
2.12
3.05
3.09
5.77
5.18
5.38
5.90
6.39
1.36
1.10
1.27
1.00
1.16
0.65
0.36
1.36
0.68
1.00
0.71
0.00
0.10
0.07
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.21

0.79

0.00

1.00

4.39

3.40

8.21

6.42

7.98

6.61

4.21

5.40

4.21

4.00

4.00

5.60

6.00

6.00

2.60

3.00

3.00

1.60

2.79

2.21

1.21

1.00

1.60

2.21

1.21

1.60

1.00

0.60

0.00

0.60

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.10

0.34

0.00

0.65

4.07

3.45

8.10

7.51

6.38

6.20

4.50

5.09

4.86

3.43

4.00

4.82

6.89

6.55

2.16

2.43

3.00

1.36

2.70

1.95

1.10

0.65

1.19

1.55

0.95

1.16

0.65

0.16

0.00

0.71

0.00

0.20

0.00

0.00

0.00

0.00

0.00

0.00

7.53
2.00
1.00
1.66
2.00
1.53
0.00
0.60
0.00
0.00
0.00
0.00
0.00
0.00
0.00

ページ(3)

0.00

0.00

input2_1.txt
0.00
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
0.00
丸瀬布地点実績流量
9.09
9.09
9.09
10.69
12.43
16.30
18.86
259.08275.79 287.79 305.39
510.10554.89 609.12 621.79
503.48473.50 462.21 442.24
337.39333.57 325.99 322.23
265.07251.65 258.31 233.77
199.98202.94 194.12 197.04
163.45162.12 164.79 156.84
141.55142.80 134.20 129.41
111.11
107.83 104.61 102.48
90.20

0.00

0.00

0.00

0.00

0.00

0.00

8.78

8.78

9.09

9.09

9.40

9.72

43.45

66.84

102.36149.14203.24233.43336.51

371.10413.59441.05456.20480.53645.81627.38609.21588.78553.86524.78416.29403.62391.13374.80360.79345.10311.09294.74289.39273.63277.10271.91225.86224.29211.96202.94207.43197.04194.12189.78188.35178.45177.06171.55150.38155.54151.66145.30152.95142.80130.60125.87

124.70120.08111.11115.55102.48101.43

98.30

97.27

95.22

93.19

0.00
0.00
0.00
0.00
0.00
0.00

ページ(4)

input2_2.txt
湧別川
湧別川
開盛
２００１年９月１２日洪水
23
10
50 0.001
75.80
10.0000.150
1.500
110 110
2001
9
10
10
8
5
1
0
1
0
0
1
0
1
0
10
11
10
1
河道Ｃ
3
10400 1.6246 0.7030
河道Ｄ
4
10000 1.7880 0.7457
河道Ｅ
52700 2.5811 0.7057
河道Ｆ
618200 0.6202 0.8894
河道Ｇ
73800 1.5965 0.8186
丸瀬布地点実績流量802.00
9.09
9.09
9.09
8.78
8.78
9.09
9.09
10.69
12.43
16.30
18.86
43.45
66.84 102.36 149.14
259.08275.79 287.79 305.39 336.51 371.10 413.59 441.05
510.10554.89 609.12 621.79 645.81 627.38 609.21 588.78
503.48473.50 462.21 442.24 416.29 403.62 391.13 374.80
337.39333.57 325.99 322.23 311.09 294.74 289.39 273.63
265.07251.65 258.31 233.77 225.86 224.29 211.96 202.94
199.98202.94 194.12 197.04 194.12 189.78 188.35 178.45
163.45162.12 164.79 156.84 150.38 155.54 151.66 145.30
141.55142.80 134.20 129.41 130.60 125.87 124.70 120.08
111.11
107.83 104.61 102.48 102.48 101.43
98.30
97.27
90.20
ＡＲＥＡ７
7
71.50
0.01
0.00
0.00
0.00
1.98
0.00
1.00
1.99
1.01
2.99
2.99
7.99
5.02
8.97
5.00
4.01
4.00
5.01
6.00
3.02
4.99
4.01
5.99
6.02
2.01
1.02
1.99
3.00
4.00
3.00
2.00
1.00
2.00
1.01
1.01
1.00
1.01
2.00
2.02
1.99
0.02
1.01
1.01
1.01
1.00
0.01
1.00
ページ(1)

0

0

9.40

9.72

203.24233.43456.20480.53553.86524.78360.79345.10277.10271.91207.43197.04177.06171.55152.95142.80111.11115.55

95.22

93.19

4.99

2.02

4.00

4.99

6.01

5.99

3.00

2.00

1.02

2.01

0.01

0.00

input2_2.txt
0.01
0.01

0.99

0.01

0.00

0.00

0.00

0.01

0.00

0.01

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
ＡＲＥＡ８
8
47.40
0.10
0.00
1.44
1.43
1.89
5.18
4.46
5.78
7.63
2.10
1.75
1.26
1.80
1.23
1.77
1.37
1.10
0.10
0.52
0.15
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ９
9
37.20
0.94
0.00
1.06
1.94
2.06
4.94
4.00
5.94
7.88
2.94
2.88
1.00
2.00
1.94
1.06
1.88
1.94
0.94
0.94
0.06
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.42

0.50

0.00

1.13

4.53

2.42

2.44

7.45

7.32

5.43

5.27

4.82

4.44

5.71

4.96

4.28

4.23

5.57

6.56

6.49

1.48

2.67

3.25

3.13

2.38

2.38

2.88

1.10

1.42

1.20

2.20

2.42

2.08

1.90

1.10

1.10

0.80

0.10

1.00

0.23

0.20

0.23

0.00

0.00

0.00

0.10

0.00

0.10

0.42

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.12

0.00

1.00

4.06

3.88

2.06

6.12

6.88

5.24

4.06

4.00

4.06

6.00

4.88

4.06

4.94

5.06

6.94

5.06

1.06

3.00

4.00

3.00

2.00

3.00

2.00

1.94

1.00

2.88

2.00

3.88

2.88

2.94

1.94

1.94

1.00

0.94

1.00

0.94

0.00

0.94

0.00

0.00

0.00

0.94

0.00

0.94

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
0.00
0.00
0.00
0.00

ページ(2)

input2_2.txt
0.00
ＡＲＥＡ１０
10
10.44
1.00
0.00
1.00
2.00
2.00
5.00
4.00
6.00
8.00
3.00
3.00
1.00
2.00
2.00
1.00
2.00
2.00
1.00
1.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ１１
11 169.59
0.00
0.00
0.17
2.00
0.34
6.00
5.83
6.66
8.66
2.00
1.83
2.66
1.83
1.83
1.17
1.00
1.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ１２12 110.81
0.53
0.00
0.53
2.00
1.06
5.47
4.94
6.47
8.47
2.53
2.53

0.00

0.00

0.00

0.00

1.00

4.00

4.00

2.00

6.00

7.00

5.00

4.00

4.00

4.00

6.00

5.00

4.00

5.00

5.00

7.00

5.00

1.00

3.00

4.00

3.00

2.00

3.00

2.00

2.00

1.00

3.00

2.00

4.00

3.00

3.00

2.00

2.00

1.00

1.00

1.00

1.00

0.00

1.00

0.00

0.00

0.00

1.00

0.00

1.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.17

0.00

1.83

6.50

1.83

1.17

3.01

7.17

2.34

3.17

4.34

3.17

6.83

6.66

4.83

4.83

5.00

7.83

8.66

2.00

2.00

3.00

3.83

4.50

2.83

3.83

1.00

1.00

1.00

2.17

1.83

2.83

1.83

1.00

1.00

0.83

0.00

1.00

0.83

0.17

0.83

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

1.47

5.41

3.06

1.53

4.12

7.00

3.59

3.53

4.00

3.53

6.47

5.94

4.47

5.00

5.00

7.47

6.88

1.47

2.53

3.53

3.47

3.41

3.00

2.94

ページ(3)

input2_2.txt
1.94
2.00

2.00

1.53

1.00

2.06

2.00

3.06

3.00

2.53

1.53

1.53

1.53

1.00

0.53

1.00

1.00

0.00

0.00

1.00

0.00

0.00

0.00

0.53

0.00

0.53

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
ＡＲＥＡ１３
13
13.76
1.00
0.00
1.00
2.00
2.00
5.00
4.00
6.00
8.00
3.00
3.00
1.00
2.00
2.00
1.00
2.00
2.00
1.00
1.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ＡＲＥＡ１４
14
72.10
0.71
0.00
1.29
1.71
2.29
4.71
4.00
5.71
7.41
2.71
2.41
1.00
2.00
1.71
1.29
1.41
1.71
0.71
0.71
0.29
0.00
0.00
0.00
0.00
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

1.00

4.00

4.00

2.00

6.00

7.00

5.00

4.00

4.00

4.00

6.00

5.00

4.00

5.00

5.00

7.00

5.00

1.00

3.00

4.00

3.00

2.00

3.00

2.00

2.00

1.00

3.00

2.00

4.00

3.00

3.00

2.00

2.00

1.00

1.00

1.00

1.00

0.00

1.00

0.00

0.00

0.00

1.00

0.00

1.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.59

0.00

1.00

4.29

3.41

2.29

6.59

6.41

6.18

4.29

4.00

4.29

6.00

4.41

4.29

4.71

5.29

6.71

5.29

1.29

3.00

4.00

3.00

2.00

3.00

2.00

1.71

1.00

2.41

2.00

3.41

2.41

2.71

1.71

1.71

1.00

0.71

1.00

0.71

0.00

0.71

0.00

0.00

0.00

0.71

0.00

0.71

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

1.00
1.53
0.53
0.53
0.00
0.00
0.00
0.00
0.00
0.00
0.00

ページ(4)

input2_2.txt
0.00
0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00
0.00
0.00
0.00
0.00
開盛地点流域平均雨量(7-14流域)
0.3276 0.0000 0.0000 0.0374
0.85351.7730 1.4426 1.8535 5.1416
5.25584.8189 6.1120 6.3361 5.3664
7.92102.3276 2.0647 1.6350 2.5546
1.74701.9281 1.7011 1.3276 1.0374
1.29891.1740 1.3276 1.3276 1.3276
0.32760.3650 0.1896 0.7011 0.0000
0.00000.0000 0.0000 0.0374 0.0000
0.00000.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000
0.00000.0000 0.0000 0.0000 0.0000
0.0000
開盛地点実績流量
48.20
48.20
45.63
45.63
56.33
62.10
66.77
72.60
78.68
219.24291.50 341.30 377.81 419.76
765.50824.74 917.74 971.56 1004.58
881.33875.96 823.21 797.44 777.13
660.73656.09 637.67 619.52 615.02
507.91495.75 475.80 464.03 448.56
382.92378.60 370.02 365.76 359.43
326.59322.59 316.64 312.71 304.92
285.87282.13 275.54 268.43 254.49
208.62
196.35 190.35 184.45 172.93
145.74

0.00

0.00

0.00

0.00

0.00

0.45250.00001.37355.31242.61936.72874.60753.92874.1812

3.85354.56314.70115.22707.14656.86483.51723.3735

3.12282.89072.85631.65252.07192.61932.51012.25570.92810.32761.00000.70110.07190.00000.00000.32760.00000.32760.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.0000

45.63

45.63

45.63

45.63

50.84

87.59

108.30118.71137.68174.25471.49514.24571.34640.27708.46958.17958.17952.57919.35886.71742.20722.61

688.95684.20665.40597.20579.63562.33549.53532.68437.13418.41

407.38396.49392.90353.15344.87338.72334.65330.61302.99299.14295.32291.52287.74247.65234.27227.72221.26214.89172.93167.30161.77156.34150.990.00

ページ(5)

17program.for.txt
c ********************************************************
c 第17回ゼミc
単一流域におけるカルマン・フィルター理論を用いた実時間流出予測c
有効雨量を用いた一般化貯留関数法＋カルマンフィルターcc 作成者 片山 直樹
作成日 2005.12.5
c ********************************************************cc
iflg=0 実測雨量を用いる
c
iflg=1 過去３時間移動平均雨量を用いる
ccs = k1*q**p1 + k2*d(q**p2)/dt
c
ds/dt = fr - qc
k1 = 2.8235 * fc * A**0.24ck2 = 0.2835 * k1**2 * rr**(-0.2648)!rr:平均有効雨量強度cp1 = 0.6（固定）cp2 = 0.4648（固定）c
状態変量cx1=q**p2cx2=d(q**p2)/dtc
f :流出率c
fc :流域平均粗度cr :予測雨量c
c 平均有効雨量強度を逐次計算する
c 平均雨量(現時間までの総雨量/ゼロでない雨の時間数)＝平均雨量強度c--------------------------------------------------------character suikei*80, kasen*80, chiten*80, title*80, rname(2)*22cdimension x(8), x_prn(8)dimension p1(5,5), p2(5,5), q(5,5), u(5,5), u2(5,5)
dimension xex(5), p1ex(5,5), p2ex(5,5)
dimension p33(5,5), p3ex(5,5)
dimension qq(200), reav(200), dis(24,200)
dimension r(200), qq0(200), hrea(200)dimension xpr(24), xpr_d(24,200), sig(24,200), sigq(24,200)
dimension ar(6),br(6)ccommon /st1/ wk1,wk2,zk2,wf,wfc,wp1,wp2,zp2,rain,n,areacommon /st2/ h,h2,h3,h4
common /st3/ alph1,alph2,alph4,akei,bkei
common /hqcv/ ax(5),bx(5),hx(5),qx(5)copen(5,file='data.dat',status='unknown')
open(6,file='kalckH.out',status='unknown')
open(50,file='kalckQ.out',status='unknown')cn=2! 更新する状態変量x1,x2
n1=2! f,fcに関する配列
n2=1! rに関する配列
iyoso=6! 予測時間幅
wp1=0.6! モデル定数p1zp2=0.4648 ! モデル定数p2
wp2=1.0/zp2cnl=10! 計算時間間隔（１時間の分割数）
xnl=nlh=1.0/xnl
ページ(1)

17program.for.txt
h2=h**2h3=h2*hh4=h3*hc
rtot=0.0
nrah=0cc***********************************************************
c データ読み込み開始c
水系名
read(5,'(a80)') suikeicc
河川名
read(5,'(a80)') kasencc
地点名
read(5,'(a80)') chitencc
洪水名
read(5,'(a80)') titlecc
流域面積
read(5,'(5f8.0)') areaccf,fc
read(5,'(3f8.0)') pa_f,pa_fc
cc
開始年、月、日、時
read(5,'(4i5)') iy,im,id,ih
c
c
降雨、水位データ数
read(5,'(2i5)') nr,nqcc
雨量
read(5,'(10f8.0)') (r(i),i=1,nr)cc水位
read(5,'(10f8.0)') (hrea(i),i=1,nq)
read(5,'(i5)') nhq! Ｈ－Ｑ式数
do j = 1, nhq
read(5,'(3f8.0)') ax(j),bx(j),hx(j)! ａ，ｂ，適用下限水位
qx(j)=ax(j)*(hx(j)+bx(j))**2
end dodo j = nhq, 5ax(j)=ax(nhq)bx(j)=bx(nhq)hx(j)=hx(nhq)qx(j)=qx(nhq)
end doc
流量算定call hqcurv( 1, 1, nq, hrea, qq0 )cc....<実測雨量:0 or 過去3時間移動平均雨量:1>予測フラグ....
rname(0)='=実測雨量'
rname(1)='=過去3時間移動平均雨量'
read(5,'(i5)') iflgcc
補正定数の設定ページ(2)

cc

17program.for.txt
実績雨量の場合
do i=1,6ar(i)=1.0
br(i)=1.0
end do
過去３時間移動平均雨量の場合
if(iflg.eq.1) thendata ar/1.021,1.252,1.394,1.0,1.0,1.0/
data br/0.851,0.686,0.585,1.0,1.0,1.0/
do i=1,nrreav(i)=(r(i)+r(i-1)+r(i-2))/3
if(i.eq.2) reav(i)=(r(i)+r(i-1))/2
if(i.eq.1) reav(i)= r(i)end doend ifcc データ読み込み終了
c***********************************************************
wf =pa_fwfc=pa_fc
c***********************************************************
c ヘッダ部分出力開始
write(6,*)'一般化貯留関数法+カルマンフィルターによる洪水予測計算'
write(6,'(''地 点 名: '',a80)') chiten
write(6,'(''開 始 時 間: '',i4,''年'',i2,''月'',+i2,''日'',i2,''時'')')iy,im,id,ih
write(6,'(''流 域 面 積 : '',f8.2)')area
write(6,'(''分割数(nl): '',i2)')nl
write(6,'(''予測雨量(iflg):'',i2,a22)')iflg,rname(iflg)
write(6,806)
806 format(/'<---貯留指数--->',+'<-ﾊﾟﾗﾒｰﾀ 初期値->')
write(6,'(6x,''p1'',6x,''p2'',7x,''f''+,6x,''fc'')')
write(6,'(2f8.4,2f8.3)') wp1,zp2,wf,wfc
write(6,807)
807 format(/19x,'<------- 予測値 ------->',+' <------- 標準偏差 ------->',+' <- モデル定数 ->')
write(6,808)
808 format(' NO ',x,'雨量 実測値',3x,&'1時間後',1x,'2時間後',1x,'3時間後',1x,2x,&'1時間後',2x,'2時間後',2x,'3時間後',2x,
&
'
f
fc')
write(50,*)'一般化貯留関数法+カルマンフィルターによる洪水予測計算'
write(50,*)'計算流量出力'
write(50,'(''地 点 名: '',a80)') chiten
write(50,887)
887 format(/19x,'<------- 予測値 ------->',+'<------- 標準偏差 ------->')
write(50,888)
888
format(' NO',2x,'実測流量',,4x,&'1時間後',3x,'2時間後',3x,'3時間後',4x,&'1時間後',3x,'2時間後',3x,'3時間後')
c ヘッダ部分出力終了
c***********************************************************
cdo i=1,nq
ページ(3)

17program.for.txt
qq1=qq0(i)if(qq1.le.1.0) qq1=1.0
qq(i)=3.6*qq1/area ! qq(i) : 観測流出高end dowrite(50,'('' 1'',f10.3,20x)')qq(1)*area/3.6 !流量の初期値印刷
cc

初期値の設定call input(x,p1,p2,p33,q,u,u2,qq(1))

cc***********************************************************c
計算開始
c***********************************************************
do 3000 ll=2,nq+1 ! llは現在時刻のループ
cdo i = 1, n+n1
x_prn(i) = x(i)end docc
平均雨量強度を逐次計算する
c
平均雨量を平均雨量強度として与えるc
現時間までの総雨量/ゼロでない雨の時間数
if(ll.le.nr) rtot = rtot+r(ll-1)
if(r(ll-1) .gt. 0.0) nrah=nrah+1
nrahy=0
rtoty=0.0cc
状態変量X1(x1,x2)の保存
do i=1,nxex(i)=x(i)end docc
X1に関する(2*2)の分散・共分散の保存
do i=1,ndo j=1,np1ex(i,j)=p1(i,j)
end doend docc
X2に関する(2*4)の分散・共分散の保存
do i=1,ndo j=1,n1p2ex(i,j)=p2(i,j)
end doend docc
X3に関する(2*1)の分散・共分散の保存
do i=1,ndo j=1,n2p3ex(i,j)=p33(i,j)
end doend docc***********************************************************c
予測計算開始c***********************************************************
cdo lt=1,iyoso
rain=0.0
ページ(4)

17program.for.txt
if(iflg.eq.0 .and. ll+lt.le.nr) rain=r(ll+lt-1) !実測雨量
if(iflg.eq.1 .and. ll+lt.le.nr) rain=reav(ll-1) !3時間移動平均雨量cc

平均雨量強度を予測雨量を踏まえて逐次更新する
if( rain .gt. 0.0 ) thennrahy=nrahy+1
rtoty=rtoty+rain
rah = x(3) * (rtot+rtoty) / (nrah+nrahy)
end ifif( rah. lt. 1.0 ) rah = 1.0 !平均雨量強度re≦1のときre=1にする

c
wk1 = 2.8235 * x(4) * area**0.24
zk2 = 0.2835* wk1**2 * rah**(-0.2648)
wk2 = 1.0 / zk2cc

予測雨量の分散（過去３時間移動平均雨量選択時）
if(iflg.eq.1) thenrain0 = rain
if( rain .lt. 0.1 ) rain0=0.1
rain0 = ar(lt)*rain0**br(lt)u2(1,1) = akei**2.0 * lt * rain0**(2.0*bkei)
end ifcc

状態変量、誤差分散・共分散の伝達
do k=1,nl
call no2kal(x,p1,p2,p33,u,u2)
if(x(1).le.0.0) thenx(1)=qq(1)**zp2x(2)=0.0
end ifend docc

乗算的ノイズxnoise=p1(1,1)+(x(1)*alph1)**2cc

予測流量算出xpr(lt)=area*x(1)**wp2/3.6
xpr_d(lt,ll)=xpr(lt)

c
c

&
c
c
c
c

! 予測流量

予測誤差分散算出
call hqcurv( 2, 1, 1, hpr, xpr(lt) )dis(lt,ll)=hpr
call hqcheck(hpr,no_hq)
b11 = 1.0 / (ax(no_hq))**0.5
varq=(wp2*(x(1)**(wp2-1.0)))**2.0*(area/3.6)**2.0*xnoise!流量についてvarh = (b11**2.0)/4.0*xpr(lt)**(-1.0)*varq !水位について
標準偏差算出sigq(lt,ll) = 1.645*varq**0.5!流量90.0%信頼区間
sig(lt,ll) = 1.645*varh**0.5!水位90.0%信頼区間
sig(lt,ll) =varh**0.5 !68.3%信頼区間（標準偏差）end doc***********************************************************
c
予測計算終了ページ(5)

17program.for.txt
c***********************************************************cc***********************************************************
c
計算結果出力write(6,809) ll-1,r(ll-1),hrea(ll-1),&(dis(i,ll),i=1,3),&(sig(i,ll),i=1,3),&(x_prn(i),i=n+1,n+n1)
809
format(i3,f6.2,f8.2,2x,3f8.2,x,3f9.4,2x,3f8.4)
write(50,899)ll,qq(ll)*area/3.6,(xpr_d(i,ll),i=1,3),&(sigq(i,ll),i=1,3)
899
format(i3,f10.3,x,3f10.3,x,3f10.3)
c***********************************************************cc
状態変量X1(x1,x2)を元に戻す
do i=1,nx(i)=xex(i)end docc
X1に関する(2*2)の分散・共分散を元に戻す
do i=1,ndo j=1,np1(i,j)=p1ex(i,j)
end doend docc
X2に関する(2*2)の分散・共分散を元に戻す
do i=1,ndo j=1,n1p2(i,j)=p2ex(i,j)
end doend docc
X3に関する(2*1)の分散・共分散を元に戻す
do i=1,ndo j=1,n2
p33(i,j)=p3ex(i,j)
end doend docrain=0.0
if(ll+1.le.nr) rain=r(ll)cc
状態変量、誤差分散・共分散の伝達
u2(1,1) = 0.0
do k=1,nl
call no2kal(x,p1,p2,p33,u,u2)
if(x(1).lt.0.0) thenx(1)=qq(1)**zp2x(2)=0.0
end ifend docc
Ｐ1に乗算的ノイズを設定
do i=1,nq(i,i)=(x(i)*alph1)**2 ! 観測誤差の分散Ｒ(ck*α4)^2
p1(i,i)=p1(i,i)+q(i,i)
end doページ(6)

17program.for.txtcz=qq(ll) ! 現在時刻の観測流出高cc

カルマンフィルターによる状態変量、誤差分散・共分散の更新
call no2upd(x,p1,p2,u,z)c
3000 continue
c***********************************************************
c
計算終了
c***********************************************************
c
stop
end
c
c
subroutine no2kal(x,p1,p2,p33,u,u2)c-------------------------------------------------------c
カルマンフィルターによる伝達方程式cs = k1*q**p1 + k2*d(q**p2)/dtcc
extrapolation equation of kalman filterclinearization of nonlinear vector equationcx(k+1) = phi*x(k) + gamma*d(k)c-------------------------------------------------------dimension x(1),y(5),f(15),g(4),z(10)dimension p1(5,5),p2(5,5),p3(5,5),p4(5,5),p5(5,5)
dimension phi1(5,5),phi2(5,5),phi3(5,5)
dimension u(5,5),u2(5,5)
dimension p33(5,5)
ccommon /st1/ wk1,wk2,zk2,wf,wfc,wp1,wp2,zp2,rain,n,areacommon /st2/ h,h2,h3,h4c
n1=2! f,fcに関する配列
n2=1! rに関する配列
cc.. 方程式の拡張部分を配列に割り当てるz(1) = x(3)! 状態変量 fz(2) = x(4)! 状態変量 fc
z(3) = rain
! 状態変量 rc
cc1=0.0
cc2=0.0
cc3=0.0cy1=x(1)y2=x(2)cc.. 計算上の変数への割り当て
if(y1.gt.0.0) then
cc1=y1**(wp1*wp2-1.0) ! x1^(p1/p2-1)
cc2=y1**(wp1*wp2-2.0) ! x1^(p1/p2-2)
cc3=y1**(wp2-1.0)! x1^(1/p2-1)
end ife1 = wk1*wk2*wp1*wp2 ! (k1/k2)*(p1/p2)
e2 = wp1*wp2! p1/p2cc.. a21～a25の計算
ページ(7)

17program.for.txt
a21 = -e1*(e2-1.0)*cc2*y2 - wk2*wp2*cc3
a22 = -e1*cc1
a23 = z(3)*wk2
ccccc
a24 = (-wk2*e2*cc1*y2) * 2.8235*area**0.24 !2005.11.02
a24 = 2.8235*area**0.24 * (wk2*e2*cc1*y2++ 2.0*y1**wp2*wk2/wk1 - 2.0*z(1)*z(3)*wk2/wk1)
a25 = z(1)*wk2
c.. b2の計算
ccccc
b2 = e1*e2*cc1*y2 + wk2*y1**wp2*(wp2-1.0) - z(1)*z(3)*wk2
b2 = e1*(e2-2)*cc1*y2 + wk2*y1**wp2*(wp2-3.0) + z(1)*z(3)*wk2
cc.. 計算上の変数への割り当て
a9 = a21 + a22**2.0
a10 = 2.0*a21*a22 + a22**3.0
bt1 = h/2.0 + a22*h2/6.0 + a9*h3/24.0
bt2 = 1.0 + a22*h/2.0 + a9*h2/6.0 + a10*h3/24.0cc.. Φ、Γの要素の計算
f(1) = 1.0 + a21*h*bt1! φ11f(2) = h*bt2! φ12f(3) = a21*f(2)! φ21
f(4) = 1.0 + a22*h + a9*h2/2.0 + a10*h3/6.0++ (a21*a9+a22*a10)*h4/24.0! φ22cg(1) = h*bt1! γ12g(2) = f(2)! γ22c
f(5) = a23*g(1)! φ13
f(6) = a24*g(1)! φ14
f(7) = a23*f(2)! φ23
f(8) = a24*f(2)! φ24c
f(9) = a25*g(1)! φ15
f(10) = a25*g(2)
! φ25
c
c
Φ1、Φ2、Φ3の配列への割り当て（ i:行、j:列 ）c..... phi1(i,j) and phi2(i,j) and phi3(i,j) matrices ........
k=0
do i=1,ndo j=1,nk=k+1
phi1(i,j)=f(k)! Φ1...(2*2)行列
end doend dock=4
do i=1,ndo j=1,n1
k=k+1
phi2(i,j)=f(k)! Φ2...(2*2)行列
end doend dock=8
do i=1,ndo j=1,n2
k=k+1
phi3(i,j)=f(k)! Φ3...(2*1)行列ページ(8)

17program.for.txt
end doend doccc

状態変量の伝達方程式（状態変量X1,X2,X3の更新）..... extrapolation of state variables .....................
do i=1,ny(i)=0.0
do j=1,ny(i)=y(i)+phi1(i,j)*x(j)! φ1の項
end dodo j=1,n1y(i)=y(i)+phi2(i,j)*z(j)! φ2の項
end dodo j=1,n2y(i)=y(i)+phi3(i,j)*z(3)! φ3の項
end doy(i)=y(i)+g(i)*b2! γの項
end docdo i=1,nx(i)=y(i)end do
c
c
c
c
c
c
c
c
c
c
c
c

c
c

c
c
c
c

! 状態変量の更新

誤差分散・共分散行列の伝達方程式..... extrapolation equation ...............................
p1(i,j) : extrapolation of covariance matrix
Φ1Ｐ1Φ1T(p3) の計算
call mul31(2,2,2,2,phi1,p1,phi1,p3)
Φ1Ｐ2Φ2T(p4) の計算
call mul31(2,2,2,2,phi1,p2,phi2,p4)
Φ1Ｐ1Φ1T(p3) ＋ Φ1Ｐ2Φ2T(p4)do i=1,ndo j=i,np3(i,j)=p3(i,j)+p4(i,j)
end doend doΦ2Ｐ2TΦ1T(p4T) を加える
do i=1,ndo j=i,np3(i,j)=p3(i,j)+p4(j,i)
end doend doΦ1Ｐ3Φ3T(p4) の計算
call mul31(2,2,2,1,phi1,p33,phi3,p4)
Φ1Ｐ3Φ3T(p4) を加える
do i=1,ndo j=i,np3(i,j)=p3(i,j)+p4(i,j)
end doend doページ(9)

17program.for.txt
c
c

c
c
c
c
c
c

c
c
c
c
c
c

Φ3Ｐ3TΦ1T(p4T) を加える
do i=1,ndo j=i,np3(i,j)=p3(i,j)+p4(j,i)
end doend doΦ2ＵΦ2T(p4) の計算
call mul31(2,2,2,2,phi2,u,phi2,p4)
Φ3Ｕ2Φ3T(p5) の計算
call mul31(2,2,1,1,phi3,u2,phi3,p5)
Ｐ1(更新値)(2*2)行列の計算
do i=1,ndo j=i,np1(i,j)=p3(i,j)+p4(i,j)+p5(i,j)
if(i.ne.j) p1(j,i)=p1(i,j)
end doend dop2(i,j) : extrapolation of covariance matrix
Φ1Ｐ2 の計算（2*2)行列
call mul21(2,3,2,phi1,p2,p3)
Φ2Ｕ の計算（2*2)行列
call mul21(2,3,3,phi2,u,p4)cdo i=1,ndo j=1,n1p2(i,j)=p3(i,j)+p4(i,j)
end doend docccccc! Ｐ2(更新値)(2*2)行列の計算

p3(i,j) : extrapolation of covariance matrix
Φ1Ｐ3 の計算（2*1)行列
call mul21(2,1,2,phi1,p33,p3)
Φ3Ｕ2 の計算（2*1)行列
call mul21(2,1,1,phi3,u2,p4)cdo i=1,ndo j=1,n2
p33(i,j)=p3(i,j)+p4(i,j)
end doend do! Ｐ3(更新値)(2*1)行列の計算

c
return
end
c
c
c
c
c

subroutine no2upd(x,p1,p2,u,z)------------------------------------------------------------カルマンフィルターによる更新方程式
update equation of kalman filter
ページ(10)c

17program.for.txt------------------------------------------------------------dimension x(1),p1(5,5),p2(5,5),u(5,5)
dimension xm1(5),xm2(5),xkal(10)dimension p3(5,5),zm1(5,5),zm2(5)ccommon /st1/ wk1,wk2,zk2,wf,wfc,wp1,wp2,zp2,rain,n,areacommon /st3/ alph1,alph2,alph4,akei,bkeicn1=2!パラメータに関する配列(f,fc)

c
err=z-x(1)**wp2cck=x(1)**wp2cc

観測誤差分散（Ｈ－Ｑ変換の誤差を考慮しない）
rq=(ck*alph4)**2chh1 = wp2 * x(1)**(wp2-1.0)! h1の計算s = p1(1,1) * hh1**2 + rq ! ＨＰＨT＋Ｒ（カルマンゲインの右辺第２項）
c
c

c
c

c
c

c
c

c
c
c
c

c
c

カルマンゲインＫ1,Ｋ2の計算（状態変量x1,x2に対するもの）
do i=1,nxm1(i) = p1(i,1) * hh1
xkal(i) = xm1(i) / s
end doカルマンゲインK3～K4の計算（f,fcに対するもの）
do i=1,n1
xm2(i) = p2(1,i) * hh1
xkal(i+n) = xm2(i) / s
end do
状態変量x1,x2,f,fcの更新
do i=1,n+n1x(i) = x(i) + xkal(i) * errend doマトリックスＭ1の計算
zm1(1,1) = 1.0 - hh1 * xkal(1)zm1(1,2) = 0.0
zm1(2,1) = -hh1 * xkal(2)zm1(2,2) = 1.0
マトリックスＭ2の計算
zm2(1) = -hh1 * xkal(3)zm2(2) = -hh1 * xkal(4)X1に関する(2*2)の誤差分散・共分散P1の更新
call mul21(2,2,2,zm1,p1,p3)
do i=1,ndo j=i,np1(i,j) = p3(i,j)
if( i. ne. j ) p1(j,i) = p1(i,j)
end doend do
パラメータの誤差分散・共分散Uの更新
do i=1,n1
ページ(11)

17program.for.txt
do j=i,n1u(i,j) = zm2(i) * p2(1,j) + u(i,j)
if( i. ne. j ) u(j,i) = u(i,j)
end doend docc

X2に関する(2*2)の誤差分散・共分散P2の更新
call mul21(2,2,2,zm1,p2,p3)
do i=1,ndo j=1,n1p2(i,j) = p3(i,j)
end doend docreturn
end
c
c
c
c
c

subroutine mul31(np,n2,n3,n4,a,b,c,d)---------------------------------------------------------multiplication of matrices a, b, and ct---------------------------------------------------------dimension a(5,5),b(5,5),c(5,5),d(5,5)

cdo 10 i=1,np
do 10 j=1,n2d(i,j)=0.0
do 12 k=1,n3
do 12 l=1,n4
12 d(i,j)=d(i,j)+a(i,k)*b(k,l)*c(j,l)
10 continue
return
end
c
c
c
c
c

subroutine mul21(np,n2,n3,a,b,c)---------------------------------------------------------multiplication of matrices a and b---------------------------------------------------------dimension a(5,5),b(5,5),c(5,5)
do 10 i=1,np
do 10 j=1,n2c(i,j)=0.0
do 12 k=1,n3
12 c(i,j)=c(i,j)+a(i,k)*b(k,j)
10 continue
return
end

c
c
c
c
c
c

subroutine input(x,p1,p2,p33,q,u,u2,qinit)---------------------------------------------------------input data for implementing kalman filter
初期値の設定---------------------------------------------------------dimension x(1),p1(5,5),p2(5,5)
dimension p33(5,5)
dimension q(5,5),u(5,5)
ページ(12)

17program.for.txt
dimension u2(5,5)
ccommon /st1/ wk1,wk2,zk2,wf,wfc,wp1,wp2,zp2,rain,n,areacommon /st2/ h,h2,h3,h4
common /st3/ alph1,alph2,alph4,akei,bkei
common /st4/ u_wf,u_wfccalph1 = 0.10
alph2 = 0.10
alph4 = 0.10cc

! システム誤差としてx1,x2に乗じる定数! 初期値の誤差分散に乗ずる定数! 観測誤差としてckに乗じる定数

予測雨量の誤差分散定数設定
akei = 1.135! 北海道全域bkei = 0.88
! 北海道全域

c
n1=2
n2=1

! f,fcに関する配列! rに関する配列cdo i=1,nx(i)=0.0
end docx(1)=qinit**zp2x(2)=0.0x(3)=wfx(4)=wfc! 状態変量x1の初期値! 状態変量x2の初期値! 状態変量x3の初期値! 状態変量x4の初期値

cdo i=1,ndo j=1,np1(i,j) = 0.0! X2に関する(2*2)の分散・共分散
end doend dop1(1,1) = (alph2*x(1))**2.0 ! X1(x1)に関する(2*2)の分散・共分散p1(2,2) = (alph2*x(1))**2.0 ! X1(x2)〃cdo i=1,ndo j=1,n1p2(i,j) = 0.0
end doend do! X2に関する(2*2)の分散・共分散

do i=1,ndo j=1,n2
p33(i,j) = 0.0
end doend do! X3に関する(2*1)の分散・共分散

do i=1,ndo j=1,nq(i,j) = 0.0
end doend do! システム誤差 分散・共分散

do i=1,n1
do j=1,n1u(i,j) = 0.0
end doend do! Ｕ1のパラメータ誤差 分散・共分散

c

c

c

ページ(13)

17program.for.txt
u(1,1)=(wf *0.1)**2
u(2,2)=(wfc*0.1)**2c
do i=1,n2
do j=1,n2
u2(i,j) = 0.0
end doend do! Ｕ2のパラメータ誤差 分散・共分散creturn
end
c
c
c
c
c
c
c

subroutine hqcurv(itype,ist,ied,h,q)---------------------------------------------------------水位流量曲線
itype=1:水位 --> 流量
itype=2:流量 --> 水位---------------------------------------------------------dimension h(1),q(1)common/hqcv/ ax(5),bx(5),hx(5),qx(5)go to (1,2),itypec
1 do 10 j=ist,ied
if(h(j).ge.0.0) thenk=1
if(h(j).ge.hx(2)) k=2
if(h(j).ge.hx(3)) k=3
if(h(j).ge.hx(4)) k=4
if(h(j).ge.hx(5)) k=5
q(j)=ax(k)*(h(j)+bx(k))**2.0
else
q(j)=-999
endif
10 continue
returnc
2 do 20 j=ist,ied
if(q(j).ge.0.0) thenk=1
if(q(j).ge.qx(2)) k=2
if(q(j).ge.qx(3)) k=3
if(q(j).ge.qx(4)) k=4
if(q(j).ge.qx(5)) k=5
h(j)=(q(j)/ax(k))**0.5-bx(k)elseh(j)=-999
endif
20 continue
return
end
c
c
c
c
c

subroutine hqcheck(hdata,no_hq)---------------------------------------------------------水位流量曲線ナンバーをチェック---------------------------------------------------------common/hqcv/ ax(5),bx(5),hx(5),qx(5)ページ(14)

17program.for.txtcno_hq=1
if(hdata.ge.hx(2)) no_hq=2
if(hdata.ge.hx(3)) no_hq=3if(hdata.ge.hx(4)) no_hq=4if(hdata.ge.hx(5)) no_hq=5creturnend

ページ(15)

data.txt
湧別川
湧別川
丸瀬布
平成１３年９月１１日洪水
802.000.6406
1.779
2001
9
10
1
110 110
0.00
0.00
0.00
0.10
0.34
0.00
0.65
4.05
2.12
3.05
3.09
8.10
7.51
6.38
6.20
5.77
5.18
5.38
5.90
4.86
3.43
4.00
4.82
6.39
1.36
1.10
1.27
2.16
2.43
3.00
1.36
1.00
1.16
0.65
0.36
1.10
0.65
1.19
1.55
1.36
0.68
1.00
0.71
0.65
0.16
0.00
0.71
0.00
0.10
0.07
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
174.00 174.00 174.00 173.99 173.99 174.00 174.00
174.05174.10 174.20 174.26 174.70 175.01 175.39 175.80
176.56
176.66 176.73 176.83 177.00 177.18 177.39 177.52
177.83178.02 178.24 178.29 178.35 178.28 178.21 178.13
177.78177.65 177.60 177.51 177.39 177.33 177.27 177.19
177.00176.98 176.94 176.92 176.86 176.77 176.74 176.65
176.60176.52 176.56 176.41 176.36 176.35 176.27 176.21
176.19176.21 176.15 176.17 176.15 176.12 176.11 176.04
175.93175.92 175.94 175.88 175.83 175.87 175.84 175.79
175.76
175.77 175.70 175.66 175.67 175.63 175.62 175.58
175.50175.47 175.44 175.42 175.42 175.41 175.38 175.37
175.302
26.11 -173.41 173.42
27.23 -173.48 174.76
10=実測雨量予測 1=過去３時間移動平均雨量予測
ページ(1)

4.07

3.45

4.50

5.09

6.89

6.55

2.70

1.95

0.95

1.16

0.00

0.20

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

0.00

174.01174.02176.20176.40177.59177.70177.99177.87177.12177.04176.67176.64176.24176.17176.03175.99175.85175.77175.50175.54175.35175.33

18program.for.txt
c ********************************************************
c 第18回ゼミc
複合流域におけるカルマン・フィルター理論を用いた実時間流出予測c
有効雨量を用いた一般化貯留関数法＋カルマンフィルターcc 作成者 貞本 均
作成日 2006.4.27
c ********************************************************
cc *
流域・河道ネットワーク識別データによる自動マトリックス作成
c *水位～流量曲線は複数設定で、交点を求めて使う
c *予測雨量は流域毎の値とする
c *河道流入量Ｉを前時刻のxであらわすc *k2をfcの関数とした場合
c---------------------------------------------------c
main program ( kalmnfc )cs = k1*q**p1+k2*d(q**p2)/dt
c
ds/dt = f*r-qck1=2.8235*fc*a^0.24
ck2=0.2835*k1^2*reave^-0.2648
c ********************************************************
c * n; number of state variables*
c * n1; number of parameters (runoff model)*
c * n2; number of predicted rainfall*c * nl; delt t control delt t =1./nl*
c * iyoso; lead time of forecast*
c *
状態量の選択*c *kase=1: x*c *kase=2: x,c*c *kase=3: x,r*c *kase=4: x,c,r*
c *
更新する状態量の選択*
c *jconl=0: x のみ更新*
c *jconl=1: xとモデル定数更新*
c ********************************************************ccharacter*80 title
c 共通common文を別ファイルから自動的に取り込む
include 'yosokufcj.cmn'ccharacter snam(350)*8
dimension x(253),re(50)dimension xex(253),ppex(253,253),mdays(12)copen(10,file='inputfc.dat',status='old')open(6,file='kalmanfck2-j.out',status='unknown')cdata mdays /31,28,31,30,31,30,31,31,30,31,30,31/cc::::::::::::::::::::::::::::::::::::::::::::::::::::::::cmdays(2)=28
read(10,'(a80)') title
write(0,*) titleccall input(snam)c
wp1=0.6
zp2=0.4648
ページ(1)

18program.for.txt
wp2=1.0/zp2
xnl=float(nl)hx=dt/3600.0/xnl
h2=hx**2.
h3=h2*hxh4=h3*hxcdo 1200 ikse=1,nkse
ac1=ck1
ac2=ck2
kase=jkase(ikse)
write(0,*) 'case=',kasen=(nryu+nkad)*2
n1=0
n2=0
nc=n
go to ( 1,2,3,4 ),kase
4 n2=nryu! x+c+r2 n1=2! x+c
go to 1
3 n2=nryu! x+r
1 continue! x
nx=n+n1+n2
go to ( 7,8,7,8 ),kase
8 if(jconl.eq.1) then ! モデル定数更新
nc=n+n1
end ifwrite(77,2124) title
ll=1
write(77,7831) kase,ll,ac1,ac2
2124 format(a80/1x,'case timeffc')
7 continuei1=n+1i2=i1+n1
write(21,2122) title,kase,jconl,nx
write(22,2123) title
2122 format(/13x,a80/16x,'case=',i2,2x,'jconl=',i2,4x,'nx=',i3)
2123 format(a80)c* ゼロクリアー
do 7010 i=1,253 ! (流域数＋河道数)*2＝＜50
do 7010 j=1,253
fmx(i,j)=0.0
amx(i,j)=0.0ax(i,j)=0.0
pp(i,j)=0.0
f(i,j)=0.0g(i,j)=0.0
7010 continueciy=iy0im=im0id=id0ih=ih0ih=ih-1
if(mod(iy,4).eq.0) mdays(2)=29
iy=iy-1900
cc #########
main program start################################
ページ(2)

18program.for.txtcc*

初期値誤差の設定
call shoki(qq(1),x)
zbkal(1)=hh0(1)zakal(1)=hh0(1)cc! qqはmm/hr====== forecasting =========================================
do 3000 ll=1,nq
write(0,*) 'll=',llcif(ll.eq.1) go to 7839

!初期値の状態から予測を始める

c212

do 212 i=1,nryu
re(i)=r(i,ll)z=qq(ll)! mm/h hq変換された流出高を観測値とする

cc....... xk+1(-) <=== xk(+) ................................
lt=0
do 200 k=1,nlc...... extrapolation equation of kalman filtering ..........
c* 状態量と誤差の推移計算 実測降雨誤差無し
if(n2.gt.0) thendo 201 i=i2,nx
pp(i,i)=0.0
201
continueend ifc----------------------call no2kal(ll,lt,k,re,x)c----------------------call wrcal(ll,k,x)
200 continuecc...... update equation of kalman filtering ................
c* 観測値によるフィルタリング
c* system error add
do 205 i=1,nq(i,i)=(x(i)*alph2)**2.
pp(i,i)=pp(i,i)+q(i,i)
205 continuec-----------------------------------------------call no2upd(ll,z,x)c
c* c1,c2,c3 の更新値 print
if(kase.eq.1 .or. kase.eq.3) go to 7839
if(jconl.ge.1) thenwrite(77,7831) kase,ll,ac1,ac2
end if
7831 format(2i5,3f10.5)
7839 continuec....... store statistics on t=k ............................
do 210 i=1,nc
210 xex(i)=x(i)do 215 i=1,nx
do 215 j=1,nx
215 ppex(i,j)=pp(i,j)
xc1=ac1
xc2=ac2c
ページ(3)

cc

18program.for.txt....... iyoso-hour ahead prediction .......................

do 250 lt=1,iyoso
c 予測雨量は流域毎の値とする
do 213 j=1,nryu
re(j)=rp(j,ll,lt)
if(n2.gt.0) theni=i2+j-1
c* 予測雨量がゼロのとき0.1mm相当の誤差分散を与えておく。
pp(i,i)=ap*ap*float(lt)*0.1**(2.*bp)
if(re(j).gt.0.1) pp(i,i)=ap*ap*float(lt)*re(j)**(2.*bp)
end if
213 continuecdo 260 k=1,nl
c ----------------------------------call no2kal(ll,lt,k,re,x)c ----------------------------------260 continuec * system error add
do 270 i=1,nq(i,i)=(x(i)*alph2)**2.
pp(i,i)=pp(i,i)+q(i,i)
270 continuecc* x(1)から水位hへの変換及び誤差伝播 *** 状態量から水位の算定***c--------------------------------call xtoh(y,py,x)c--------------------------------ypr(lt)=yyva(lt)=py
250 continuec3001 continue
ih=ih+1
if(ih.gt.24) thenih=1
id=id+1
if(id.gt.mdays(im)) thenid=1
im=im+1
if(im.gt.12) thenim=1
iy=iy+1
end ifend ifend ifkkm(ll)=im
kd(ll)=idkh(ll)=ihcdo 310 i=1,nc
310 x(i)=xex(i)do 315 i=1,nx
do 315 j=1,nx
315 pp(i,j)=ppex(i,j)
go to ( 25,26,25,26 ) kase
26 continue
ページ(4)

18program.for.txt
if(jconl.eq.1) thenac1=xc1ac2=xc2
end if25 continuec * 予測結果を格納する
call store(ll)3000 continuec * 予測結果をファイルに出力する
call fileo
c * 全地点のアウトプット*
nkp=(nall-1)/14+1
do 3435 k=1,nkp
kp1=(k-1)*14+1
kp2=k*14if(kp2.gt.nall) kp2=nall
write(6,3456) (snam(kp),kp=kp1,kp2)
do 3434 i=1,nq
if(k.ne.nkp) write(6,3457) i,nl,(wr(kp,i,nl),kp=kp1,kp2)
if(k.eq.nkp) write(6,3458) i,nl,(wr(kp,i,nl),kp=kp1,kp2)*,r(nryu+1,i),wr(nall+1,i,nl)
3434 continue
3435 continue
3456 format(2x,'ll',2x,'k',14a8)
3457 format(i4,i3,14f8.2)
3458 format(i4,i3,16f8.2)
c1200 continue
stop
end
c
c***********************************************************************
subroutine input(snam)
include 'yosokufcj.cmn'
character snam(350)*8
dimension a1(350),a2(350),a3(350),a4(350)c***** 流域流出解析と河道追跡のためのデータ入力
c
nl:１時間の計算分割数cdt:データ入力時間間隔なども含む計算の基本時間間隔(標準は3600sec)c
xrave:>0 のときrave=xrave とする(全流域同一値が使われる)c
hiq:河道上流端平均流入量の比流量(0.5m3/s/km2を標準値とする)
c
ck1,ck2:モデル定数c
nr:雨量入力時間数 nq:計算時間数(=水位流量入力時間数)c
nko :計算地点数cnryu:流域数（雨量入力流域）
nqin:上流端流入量入力地点数cnkad:追跡計算地点数（河道および直下が河道でない合流点の合計数）
c
nall:全地点数
r:流域毎時雨量 qd:上流端毎時流入量ca1(i):area:流域面積(km2) -->上流端流入の流域面積も入力すること
ca2(i):cleg:河道長(m) a3(i):alph:α a4(i):cmm:ｍchlm:実測水位がhlm以上の期間についてRMSEを計算する
read(10,'(i5,5x,3f10.0)') nl,dt,xrave,hiq
read(10,'(8f10.0)') ck1,ck2! f0,fc0
read(10,'(4i5)') iy0,im0,id0,ih0
read(10,'(2i5,f10.0)') nr,nq,hlm
read(10,'(4i5)') nkoif(nl.le. 0 ) nl=10
if(dt.lt. 1.) dt=3600.
! dt=3600sec が基本
if(hiq .le. 0.) hiq=0.5
ページ(5)

18program.for.txt
nrp=nqif(nr.le.0 .or. nq.le.0) stop "nr=0 or nq=0"
if(nko.le.0) stop "nko=0"
nryu=0nqin=0nkad=0ngor=0nminus=0
sama=0.0! 流域のみの合計面積(km2)
suma=0.0! 上流端流入の面積も含む全面積(km2)
do 10 i=1,nko
read(10,'(4x,5i4,10x,4f10.0)') mmod(i),mwr(i)*,los(i),lwr(i,1),lwr(i,2)*,a1(i),a2(i),a3(i),a4(i)nm1=mmod(i)-mmod(i)/10*10
if(nm1.eq.1) go to 11 !<--流域
if(nm1.eq.2) go to 12 !<--上流端
if(nm1.eq.3) go to 13 !<--河道追跡if(nm1.eq.4) go to 14 !<--合流点
stop
11 nryu=nryu+1
area(nryu)=a1(i)sama=sama+a1(i)go to 10
12 nqin=nqin+1
arez(nqin)=a1(i) ! 上流端流入量についても面積を入力する
suma=suma+a1(i)go to 10
13 nkad=nkad+1
cleg(nkad)=a2(i)! Lalph(nkad)=a3(i)! αcmm(nkad)=a4(i)! mif(los(i).ge.2) go to 10
c* 流域qと河道inが同じ場所を探す
if(lwr(i,1).eq.mwr(i)) then
nminus=nminus+1
end ifgo to 1014 continuengor=ngor+1
10 continue
suma=suma+sama
nall=nryu*2+nkad*2+ngor+nqin-nminus
write(66,6613) nall,nryu,nkad,ngor,nqin,nminus
6613 format('nall--nminus',6i3)cif(nryu.le.0) stop '流域数＞0 にすること'
cc* 全地点の名前readする（右詰めで入力した方がきれいに出力される）
read(10,'(8(2x,a8))') (snam(i),i=1,nall)cc* 雨量データreadif(nryu.le.0) go to 7101
do 29 i=1,nryu+1
do 29 j=1,nqr(i,j)=0.0
29 continue
ページ(6)

18program.for.txt
read(10,*)do 20 j=1,nr
read(10,'(50f10.0)') (r(i,j),i=1,nryu)
20 continue
c* readした雨量データをwrに格納
nry=0
do 21 nks=1,nko
nm1=mmod(nks)-mmod(nks)/10*10
if(nm1.ne.1) go to 21
nry=nry+1
iw=mwr(nks)do 22 j=1,nr
do 22 k=1,nl
wr(iw,j,k)=r(nry,j)
22 continue
21 continue
c* 流域平均雨量計算
do 723 j=1,nrr(nryu+1,j)=0.0
723 continue
do 724 j=1,nr
do 724 i=1,nryu
r(nryu+1,j)=r(nryu+1,j)+r(i,j)*area(i)/sama
724 continue
do 725 i=1,nryu
rave(i)=0.0
ir=0
do 726 j=1,nr
if(r(i,j).gt.0.) thenrave(i)=rave(i)+r(i,j)
ir=ir+1
end if
726 continuerave(i)=rave(i)/float(ir)! 流域ごとの平均雨量
if(xrave.gt.0.) rave(i)=xrave ! 予測の時は通常xraveを与えておく
725 continue
7101 continue
c* 上流端流入量データread＆格納
if(nqin.le.0) go to 7102
read(10,*)do 30 j=1,nq
read(10,'(10f10.0)') (qd(i,j),i=1,nqin)
30 continue
nzy=0
do 31 nks=1,nko
nm1=mmod(nks)-mmod(nks)/10*10
if(nm1.ne.2) go to 31
nzy=nzy+1
iw=mwr(nks)do 32 j=1,nq
wr(iw,j,nl)=qd(nzy,j)if(j.eq.1) qqq=qd(nzy,j)if(j.gt.1) qqq=qd(nzy,j-1)
dqz=(qd(nzy,j)-qqq)/float(nl)do 166 k=1,nl
wr(iw,j,k)=qqq+dqz*float(k)166 continue
32 continue
ページ(7)

18program.for.txt
31 continue
7102 continuec 各計算地点の上流全面積を求める areak(nko)asum=0.0
iryu=0jqin=0
icn=0
ist=1
do 950 nks=1,nko
nm10=mmod(nks)/10+1! 本川・支川の区別
nm1=mmod(nks)-mmod(nks)/10*10
if(nm10.eq.ist) go to 800
if(nm10.lt.ist) go to 801dare(ist)=asum
asum=0.0
ist=ist+1
go to 800801 continue
asum=asum+dare(ist-1)
ist=ist-1
800 continue
go to ( 821,822,823,824 ) ,nm1
821 continue
iryu=iryu+1
asum=asum+area(iryu)
areak(nks)=area(iryu) ! 流域は常に最上流端である
cx
areak(nks)=asum
go to 950
822 continue
jqin=jqin+1
asum=asum+arez(jqin)
areak(nks)=arez(jqin) ! 上流端なのだからその上流はない
cx
areak(nks)=asum
go to 950
823 continue
icn=icn+1
824 continue
areak(nks)=asumif(nm1.eq.4) go to 950cc
無次元領域で計算したk3，k4を使って実領域のk3,k4に換算する
amm=cmm(icn)call kpxcal( amm,wk01,wk02,wp01,wp02 )qm=hiq*3.6 ! mm/hr --->q* ﾊｯﾄ のことcck3,k4をm3,hr系に換算する
an=areak(nks)! Ae1=alph(icn)*cleg(icn)! αL(河道長の単位は[km]では無く[m])e2=cmm(icn)! me3=an/3.6
e4=1000.*an
e5=e3**e2*e1*qm**(e2-wp01)/e4
e6=e3**(2.*e2-1.)/e4*e1*e1/3600.*qm**(2.*e2-wp02-1.)
vk3(icn)=wk01*e5 ! Kh3
zk4=wk02*e6! Kh4
vk4(icn)=1./zk4
vp3(icn)=wp01! p3
zp4(icn)=wp02! p4
ページ(8)

18program.for.txt
950 continue
c*************************************************************
cs jysr=1 予測雨量を(現時刻を含む)前３時間平均雨量とし、自動計算する。
cs jysr=0 予測雨量をreadする（１流域分だけ入力し、全流域同一値とする）
cs jysr=2 予測雨量をreadする（流域ごとに入力する）
cs jysr<0 完全予測雨量とする（予測雨量の入力なし）
c* alph1: model parameter error
c* alph2: system noisec* alph3: 観測誤差vk（観測誤差分散rq=(ck*alph3)**2）
c* beta: initial value error
c* ap,bp: predicterd rainfall error ap**2*l*rp**2bp
c*************************************************************cread(10,104) jconl,jysr,iyoso,&nkse,(jkase(j),j=1,nkse)
if(iyoso.le.0) iyoso=6
read(10,101) alph1,alph2,alph3,beta,ap,bp
if(alph1.gt.900.) read(10,101) (alpc(i),i=1,3)! c11,c12,c13の標準偏差を与えるとき
write(21,401) alph1,alph2,alph3,beta,ap,bp,xrave,hiq
write(21,402) ck1,ck2,(alpc(i),i=1,3)
100 format(16i5)
101 format(8f10.0)
102 format(a80)
103 format(16f5.0)
104 format(2i2,6x,15i5)
108 format(10f8.0)
401 format(18x,'alph1
alph2
alph3
beta'
* 8x,'ap',8x,'bp',5x,'xrave',7x,'hiq',/13x,8f10.3)
402 format(21x,'ff',8x,'fc',6x,'alc1',6x'alc2'*,6x,'alc3'/13x,5f10.3)cc+++++++ h-q 式とその数nhc read++++++++
c* h0:H-Q式の基準標高 q=a0(h+a1)^2 の h が、h0からの高さをc*使うようになっているときに入力する。
read(10,105) nhc,h0
105 format(i5,8f10.0)
write(21,405) nhc,h0
405 format(13x,'nhc=',i3,10x,'h0=',f9.3,1x,*'q=a(h+b)^2',10x,' h=b0+b1*sqrt(q)' /*13x,9x,'a',9x,'b',8x,'b0',8x,'b1')
do 160 i=1,nhc
read(10,101) ab0(i),ab1(i) ! q=ab0(i)*(h-h0+ab1(i))^2
bb0(i)=-(ab1(i)-h0)bb1(i)=1./sqrt(ab0(i))
write(21,403) i,ab0(i),ab1(i),bb0(i),bb1(i)403 format(10x,i2,1x,4f10.4)
160 continue
if(nhc.le.4) thendo 161 i=nhc+1,5
161 write(21,403) i
end ifccccccccccc
hq 式の交点を hc,qc とする cccccccccccccccccccc
if(nhc.le.1) go to 176
do 163 i=1,nhc-1
hc(i)= bb0(i)+bb1(i)*(bb0(i+1)-bb0(i))/(bb1(i)-bb1(i+1))
163 continue
do 175 i=1,nhc-1
ページ(9)

18program.for.txt
175 qc(i)=ab0(i)*(hc(i)+ab1(i)-h0)**2. ! m3/s
176 continuecc * 実測水位をreadして流量変換する
read(10,107) ij
107 format(i2)if(ij.eq.0) read(10,101) (hh0(i),i=1,nq)
if(ij.eq.1) read(10,108) (hh0(i),i=1,nq)
do 168 i=1,nq
jj=1
if(nhc.le.1) go to 223
do 222 k=1,nhc-1
jj=kif(hh0(i).lt.hc(k)) go to 223
222 continue
jj=nhc223 continue
qz(i)=((hh0(i)-bb0(jj))/bb1(jj))**2.
if(qz(i).lt.0.) thenwrite(6,6771) i,jj,hh0(i),bb0(jj),bb1(jj),qz(i)6771
format(2i4,4f10.3)
stop "hq変換後流量が負になる"
end ifif(i.eq.1) qqq=qz(i)if(i.gt.1) qqq=qz(i-1)
dqz=(qz(i)-qqq)/float(nl)do 167 k=1,nl
wr(nall+1,i,k)=qqq+dqz*float(k)167 continue
write(66,6611) i,wr(nall+1,i,nl),qz(i)6611 format(i5,2f10.2)
168 continue
do 190 i=1,nq
qq(i)=qz(i)*3.6/suma! mm/h190 continuecc * 予測雨量
if(jysr.eq.1) then ! 流域ごとに流域平均雨量の前３時間平均雨量を予測雨量とする
do 164 i=1,nryu
do 164 j=1,nrp
if(j.eq.1) rp(i,j,1)=r(i,j)
if(j.eq.2) rp(i,j,1)=(r(i,j-1)+r(i,j))/2.
if(j.ge.3) rp(i,j,1)=(r(i,j-2)+r(i,j-1)+r(i,j))/3.
do 164 k=2,iyoso
rp(i,j,k)=rp(i,j,1)
164 continue
elseif(jysr.eq.0) then ! 予測雨量を１ケース入力して全流域同一値にする
read(10,*)do 180 j=1,nrp
read(10,'(24f8.0)') (rp(1,j,k),k=1,iyoso)
180 continue
do 181 i=2,nryu
do 181 j=1,nrp
do 181 k=1,iyoso
rp(i,j,k)=rp(1,j,k)
181 continue
elseif(jysr.eq.2) then
! 予測雨量を入力値にする -->流域の数だけ入力
ページ(10)18program.for.txt
する
do 182 i=1,nryu
read(10,*)do 182 j=1,nrp
read(10,'(24f8.0)') (rp(i,j,k),k=1,iyoso)
182 continue
elseif(jysr.lt.0) then! 完全予測雨量にする
do 183 i=1,nryu
do 183 j=1,nrp
do 183 k=j+1,j+iyoso
rp(i,j,k-j)=r(i,k)
183 continue
end ifcc * 予測上流端流入量
if(nqin.gt.0) then ! 予測上流端流入量を与える(readする)
do 189 j=1,nqin
read(10,*)do 189 i=1,nq
read(10,'(24f10.0)') (qdp(i,j,k),k=1,iyoso)
189 continue
end ifreturnendcc*****************************************************
subroutine xtoh(y,py,x)c ****************************************************
c * x1=>h and cal. error of predicted water level*c *y:流出高の期待値*
c *py:流出高の誤差分散*
c ****************************************************
c*include 'yosokufcj.cmn'
dimension x(253),h(253,253),aa(253,253),bb(253,253)
dimension ppy(253,253),kkb(5)cdo 110 i=1,nx
do 110 j=1,nx
110 h(i,j)=0.0c
H行列の成分を指定
y=0.0
ist0=1
iryu=nryu
icn=nkad
kry=0
kka=0
kkc=0
do 301 i=1,5301 kkb(i)=0
iat=ist0
do 302 nks=nko,1,-1
call eqsys(nks,nm1,ist0,iat,iryu,icn,kry,*
kka,kkb,kkc,kkd,ihh,p2h,ah,xh,x)if(kkd.ge.1 .or. nm1.eq.4) go to 302
if(nm1.eq.2) theniw=mwr(nks)p2h=1.0
ページ(11)

18program.for.txt
ah=areak(nks)xh=zr(iw)*3.6/ah! mm/hr
go to 304
end ifh(1,ihh)=xh**(1./p2h-1.)/p2h*ah/suma
304 continue
y=y+xh**(1./p2h)*ah/suma! mm/hr 予測流出高
if(mmod(nks).eq.3) go to 333
302 continue
333 continueccall matmul(1,nx,nx,h,pp,aa)call matt(1,nx,h,bb)call matmul(1,nx,1,aa,bb,ppy)
py=ppy(1,1)! 予測流出高の誤差分散(mm/hr)^2c *returnendcc *---------------------------------subroutine store(ll)include 'yosokufcj.cmn'
do 100 i=1,iyoso
zqm=suma /3.6*ypr(i)! m3/scall qtoh(jj,zqm,zh)qf(ll,i)=zqm
hf(ll,i)=zh
sdh=0.0
if(yva(i).lt.0.0) go to 110
sdq=(suma/3.6)*sqrt(yva(i))! 予測流量の標準偏差
sdh=bb1(jj)/2.*suma/3.6*sqrt(yva(i)/zqm) ! 予測水位の標準偏差110 continuecxhl(ll,i)=hf(ll,i)-sdh!標準偏差cx
hu(ll,i)=hf(ll,i)+sdhql(ll,i)=qf(ll,i)-1.645*sdq!流量の90%信頼区間
qu(ll,i)=qf(ll,i)+1.645*sdqhl(ll,i)=hf(ll,i)-1.645*sdh!水位の90%信頼区間
hu(ll,i)=hf(ll,i)+1.645*sdh
100 continue
returnend
cc ///////////////////////////////////////////////////
subroutine fileo
include 'yosokufcj.cmn'
c
np=nq
c
call gosa
write(21,661) (rmse(j),j=1,6)
write(21,662) (ajre(j),j=1,3)
write(21,663) (ajpe(j),j=1,3)
661 format(49x,'rmse',6f10.5)
662 format(49x,' jre',3f10.5)
663 format(49x,' jpe',3f10.5)cwrite(21,*) '水位予測結果'
write(21,625)
ページ(12)

18program.for.txt
write(22,*) '流量予測結果'
write(22,625)
625 format(56x,'predict',25x,'σ',28x,'m-σ',26x,'m+σ'* /4x,' m d h ',6x,'rain',4x,'observ
beforeafter',* 4(5x,'1hr',7x,'2hr',7x,'3hr',2x))do 100 i=1,np
write(21,634) i,kkm(i),kd(i),kh(i),r(nryu+1,i),hh0(i),zbkal(i)* ,zakal(i),(hf(i,j),j=1,3),(hu(i,j)-hf(i,j),j=1,3)* ,(hl(i,j),j=1,3),(hu(i,j),j=1,3)
write(22,634) i,kkm(i),kd(i),kh(i),r(nryu+1,i),qz(i)* ,qbkal(i)*(suma/3.6),qakal(i)*(suma/3.6),(qf(i,j),j=1,3)* ,(qu(i,j)-qf(i,j),j=1,3),(ql(i,j),j=1,3),(qu(i,j),j=1,3)
100 continue
634 format(4i3,1x,f10.2,3f10.3,4(3f10.3))
returnend
cc#########################################################
subroutine no2kal(ll,lt,k,re,x)c-------------------------------------------------------c
nonlinear storage function modelcs = k1*q**p + k2*dq/dtcextrapolation equation of kalman filterclinearization of nonlinear vector equationcx(k+1) = phi*x(k) + gamma*d(k)c-------------------------------------------------------include 'yosokufcj.cmn'
dimension x(253),y(253),re(50)dimension dm(253,253),bb(253,253),cc(253,253)c*
do 130 i=1,nx
do 130 j=1,nxdm(i,j)=0.0ax(i,j)=0.0
amx(i,j)=0.0
130 fmx(i,j)=0.0ciryu=0
icn=0
nzy=0
do 950 nks=1,nko
nm1=mmod(nks)-mmod(nks)/10*10
go to ( 221,222,223,950 ) ,nm1
221 continue
c* 流域流出計算
iryu=iryu+1
rain=re(iryu)
call ryuik(iryu,rain,x)
go to 950
222 continue
c* 上流端流入計算
nzy=nzy+1
iw=mwr(nks)zr(iw)=wr(iw,ll,k)if(lt.gt.0) thenif(lt.eq.1) qqq=qd(nzy,ll)if(lt.gt.1) qqq=qdp(ll,nzy,lt-1)
dqz=(qdp(ll,nzy,lt)-qqq)/float(nl)ページ(13)

18program.for.txt
zr(iw)=qqq+dqz*float(k)end ifgo to 950
c* 河道追跡＆合流計算
223 continue
icn=icn+1
call chase(nks,icn,x)
950 continuecc* d2 を求める
call matmul(nx,nx,1,amx,ax,cc)
call matsub(nx,1,fmx,cc,dm)c
c* 線形方程式の差分化
c* dx/dt=ax+d => x(k+1)=f(k)x(k)+g(k)d(k)call risancc..... calculation of state variables ....................
do 140 i=1,ny(i)=0.0
do 145 j=1,nx
145 y(i)=y(i)+f(i,j)*ax(j,1)
do 150 j=1,nx
150 y(i)=y(i)+g(i,j)*dm(j,1)
140 continuecdo 160 i=1,nx(i)=y(i)if(mod(i,2).eq.1 .and. x(i).lt.0.0) x(i)=0.0
160 continuecc..... extrapolation equation .............................
cpp(i,j) : extrapolation of covariance matrix
c* 誤差共分散行列の伝達 p(k+1)=Φ(k)p(k)Φt(k)call matmul(nx,nx,nx,f,pp,bb)call matt(nx,nx,f,cc)
call matmul(nx,nx,nx,bb,cc,pp)
c
returnendcc ===============================================
subroutine ryuik(iryu,rain,x)
include 'yosokufcj.cmn'
dimension x(253)ck1=(iryu-1)*2+1
k2=iryu*2
wk1=2.8235*ac2*area(iryu)**0.24
zk2=0.2835*wk1*wk1*rave(iryu)**(-0.2648)
wk2=1./zk2c***** 分割流域における流出計算
c1=0.0c2=0.0c3=0.0c4=0.0y1=x(k1)y2=x(k2)
ページ(14)

18program.for.txt
if(y1.le.0.0) go to 100
c1=y1**(wp1*wp2-1.0)
c2=y1**(wp1*wp2-2.0)
c3=y1**(wp2-1.0)
c4=y1**wp2
100 continue
e1 = wk1*wk2*wp1*wp2
e2 = wp1*wp2
c* dx/dt=a(x)*x+d(x)c* f(x)=>fmx, a(x)=>amx, x=>ax
amx(k1,k2)=1.0
amx(k2,k1) = -e1*(e2-1.0)*c2*y2-wk2*wp2*c3
amx(k2,k2) = -e1*c1
fmx(k1,1)=y2
fmx(k2,1)=-e1*c1*y2-wk2*c4+ac1*rain*wk2
ax(k1,1)=y1
ax(k2,1)=y2
go to ( 1,2,3,4 ),kase
4 continueamx(k2,i2+iryu-1)=ac1*wk2
ax(i2+iryu-1,1)=rainx(i2+iryu-1)=rain
go to 23 continueamx(k2,i1+iryu-1)=ac1*wk2
ax(i1+iryu-1,1)=rainx(i1+iryu-1)=rain
go to 1
2 continueamx(k2,i1 )=rain*wk2! r/k2=df2/df
cx *** df2/dfc=df2/dk1*dk1/dfc+df2/dk2*dk2/dk1*dk1/dfc
amx(k2,i1+1)=(e1*c1*y2+2.*wk2*c4-2.*ac1*rain*wk2)/ac2
ax(i1 ,1)=ac1
ax(i1+1,1)=ac2x(i1 )=ac1x(i1+1)=ac2
1 continue
returnendcc ===============================================
subroutine chase(nks,icn,x)
include 'yosokufcj.cmn'
dimension x(253),kkb(5)cc ** 河道流入量iの設定 **c
上流端流入は現ステップt=kの値を入力する
c
an=areak(nks)l1=nryu*2+icn*2-1
l2=l1+1
wk3=vk3(icn)
wp3=vp3(icn)
wk4=vk4(icn)
wp4=1./zp4(icn)cist0=mmod(nks)/10+1
iryu=0
ページ(15)

18program.for.txt
do i=nks-1,1,-1
nn1=mmod(i)-mmod(i)/10*10if(nn1.eq.1) theniryu=iryu+1
end ifend dorain=0.0
icm=icn-1
kry=0
kka=0
kkc=0
do 309 i=1,5309 kkb(i)=0
iat=ist0
do 304 i=nks-1,1,-1
call eqsys(i,nn1,ist0,iat,iryu,icm,kry,*
kka,kkb,kkc,kkd,ihh,p2h,ah,xh,x)if(kkd.eq.2) go to 304
if(kkd.eq.1 .or. nn1.eq.4) go to 304
if(nn1.eq.2) theniw=mwr(i)p2h=1.0
ah=areak(i)xh=zr(iw)*3.6/ah! mm/hr
go to 303
end ifamx(l2,ihh)=wk4/p2h*xh**(1./p2h-1.)*ah/an
303 continue
rain=rain+xh**(1./p2h)*ah/an! t-1
304 continue
305 continueccon=wk3*wk4*wp3*wp4
a=0.0
c=0.0
d=0.0
e=0.0
y1=x(l1)! t-1の値
y2=x(l2)
if(y1.gt.0.0) go to 12
if(y1.lt.0.0) y1=0.0
go to 14
12 a=y1**(wp3*wp4-2.)
c=y1**(wp4-1.)
d=y1**(wp3*wp4-1.)
e=y1**wp4
14 continue
a1=-con*(wp3*wp4-1.)*a*y2-wk4*wp4*c
a2=-con*damx(l1,l2)=1.0
amx(l2,l1)=a1
amx(l2,l2)=a2
fmx(l1,1)=y2
fmx(l2,1)=-con*d*y2-wk4*e+rain*wk4! rainは t-1 の値
ax(l1,1)=y1! xt-1ax(l2,1)=y2
returnend
ページ(16)

18program.for.txtcc ===============================================c***** 河道追跡貯留関数モデル定数算定の近似式csubroutine kpxcal( amm,ak1,ak2,ap1,ap2 )cdimension a(0:3),b(0:4,4),c(0:4,4),d(0:4,4),e(0:4,4)
data b /0.8545, -4.8430, 33.8238, -72.2531, 49.7646
1,
0.2404, -1.1777,
8.0276, -16.2876,
9.80262,
0.5844, 0.9107, -32.9092, 96.5526, -80.2872
3, -0.3999, 10.4083, -47.3310, 71.7788, -31.9668 /data c /0.5229, 22.7545,-154.6917, 327.8772,-224.9687
1,
1.0848, 23.9708,-126.7464, 230.5159,-124.7640
2, -0.9989, -18.7643, 216.3786,-546.4481, 422.4272
3,
1.3325, -34.6802, 151.6250,-223.8849, 95.8506 /data d /-0.8426, -39.5757, 249.2689,-512.7692, 345.5463
1,
0.1929, -19.1466, 90.2282,-157.3522, 79.5772
2,
2.7263, 53.1813,-427.1458, 976.2463,-713.3760
3, -0.7202, 24.5035, -98.6764, 138.5036, -52.1388 /data e /0.2763, 22.4122,-130.0060, 259.4679,-171.6907
1,0.0000, 0.0000,
0.0000,0.0000,0.00002, -1.1199, -37.4282, 249.4726,-535.5305, 376.2721
3,0.0000, 0.0000,
0.0000,0.0000,0.0000 /c
tar=0.5
call a03cal( a(0),b(0,1),c(0,1),d(0,1),e(0,1),tar )ak1 = a(0)+a(1)*amm+a(2)*amm**2.+a(3)*amm**3.
ccall a03cal( a(0),b(0,2),c(0,2),d(0,2),e(0,2),tar )ak2 = a(0)*exp(a(1)*amm+a(2)*amm**2.)ccall a03cal( a(0),b(0,3),c(0,3),d(0,3),e(0,3),tar )ap1 = a(0)+a(1)*amm+a(2)*amm**2.+a(3)*amm**3.
ccall a03cal( a(0),b(0,4),c(0,4),d(0,4),e(0,4),tar )ap2 = a(0)+a(1)*amm+a(2)*amm**2.
creturnendcc ===============================================
subroutine a03cal( a,b,c,d,e,tar )dimension a(0:3),b(0:4),c(0:4),d(0:4),e(0:4)ca(0) = b(0)+b(1)*tar+b(2)*tar**2.+b(3)*tar**3.+b(4)*tar**4.
a(1) = c(0)+c(1)*tar+c(2)*tar**2.+c(3)*tar**3.+c(4)*tar**4.
a(2) = d(0)+d(1)*tar+d(2)*tar**2.+d(3)*tar**3.+d(4)*tar**4.
a(3) = e(0)+e(1)*tar+e(2)*tar**2.+e(3)*tar**3.+e(4)*tar**4.
c
returnendcc ===============================================
subroutine risanc*
線形方程式の差分化
include 'yosokufcj.cmn'
c* dx/dt=ax+b => x(k+1)=f(k)x(k)+g(k)b(k)dimension um(253,253),at(253,253)
ページ(17)

18program.for.txt
dimension aw(253,253),bw(253,253),cw(253,253)ct=hx
c* テイラー展開の項数計算
atmax=0.
do 100 i=1,nx
do 100 j=1,nx
at(i,j)=amx(i,j)*t
ata=abs(at(i,j))
if(ata.gt.atmax) atmax=ata
100 continuec*c* matrix要素の大きさにかかわらず項数一定
rm=4.
km=4
c
c* 単位行列
call mati(nx,um)
c* x(k+1)=f(k)*x(k)+g(k)*b(k) f(k),g(k)の計算
c
if(km.eq.1) thencall matad(nx,nx,um,at,f)call matc(nx,nx,um,t,g)
else
ao=1./rm
call matc(nx,nx,at,ao,aw)
call matad(nx,nx,aw,um,bw)
if(km.eq.2) go to 130
do 140 j=km-1,2,-1
bo=1./float(j)call matc(nx,nx,at,bo,aw)
call matmul(nx,nx,nx,aw,bw,cw)
call matad(nx,nx,cw,um,bw)
140
continue
130
call matmul(nx,nx,nx,at,bw,cw)
call matad(nx,nx,cw,um,f)call matc(nx,nx,bw,t,g)
endif
returnendc==============================================================
subroutine no2upd(ll,z,x)c-----------------------------------------------------------c
update equation of kalman filterc==============================================================
include 'yosokufcj.cmn'
dimension x(253),h(253,253)
dimension w1(253,253),w2(253,253),w3(253,253)
dimension gain(253,253),ht(253,253)
dimension kkb(5)cc 更新前流出高
zq=wr(nall,ll,nl)! m3/sqbkal(ll)=zq*3.6/suma! mm/hsqq=sqrt(zq)c 計算流量を水位変換するためのjjを計算する。
jj=1
if(nhc.le.1) go to 9
ページ(18)

18program.for.txt
do 8 i=1,nhc-1
jj=iif(zq.lt.qc(i)) go to 9
8 continue
jj=nhc9 continueczcal=bb0(jj)+bb1(jj)*sqq
zbkal(ll)=zcal
err=z-qbkal(ll)! 水位 elm! elm! mm/hccc*gain : kalman gain
観測方程式の線形化
do 110 i=1,nx
do 110 j=1,nx
110 h(i,j)=0.0c
H行列の成分を指定
ist0=1
iryu=nryu
icn=nkad
kry=0
kka=0
kkc=0
do 309 i=1,5309 kkb(i)=0
iat=ist0
do 304 nks=nko,1,-1
call eqsys(nks,nm1,ist0,iat,iryu,icn,kry,*
kka,kkb,kkc,kkd,ihh,p2h,ah,xh,x)if(kkd.ge.1 .or. nm1.eq.2 .or. nm1.eq.4) go to 304
h(1,ihh)=xh**(1./p2h-1.)/p2h*ah/suma
if(mmod(nks).eq.3) go to 305
304 continue
305 continue
c* カルマン･ゲイン行列の計算
call matmul(1,nx,nx,h,pp,w1)
call matt(1,nx,h,ht)
call matmul(1,nx,1,w1,ht,w3)
c* rq: 観測誤差
ck=qbkal(ll)rq=ck*alph3*ck*alph3c
hphtr=w3(1,1)+rq
w2(1,1)=1./hphtr
ccall matmul(nx,nx,1,pp,ht,w1)
call matmul(nx,1,1,w1,w2,gain)cc..... update state variables ...............................
c* 状態量の更新 x(+)
do 120 i=1,ncx(i)=x(i)+gain(i,1)*err
if(i.gt.n) go to 120
if(mod(i,2).eq.1 .and. x(i).lt.0.) x(i)=0.0
120 continue
c 更新後流出高
qakal(ll)=0.0
ist0=1
ページ(19)

18program.for.txt
iryu=nryu
icn=nkad
kry=0
kka=0
kkc=0
do 306 i=1,5306 kkb(i)=0
iat=ist0
do 307 nks=nko,1,-1
call eqsys(nks,nm1,ist0,iat,iryu,icn,kry,*
kka,kkb,kkc,kkd,ihh,p2h,ah,xh,x)if(kkd.ge.1 .or. nm1.eq.4) go to 307
if(nm1.eq.2) theniw=mwr(nks)p2h=1.0
ah=areak(nks)xh=wr(iw,ll,nl)*3.6/ah! mm/hrend ifqakal(ll)=qakal(ll)+xh**(1./p2h)*ah/suma! mm/hr
if(mmod(nks).eq.3) go to 308
307 continue
308 continue
zq=qakal(ll)*suma /3.6
! m3/ssqq=sqrt(zq)c 計算流量を水位変換するためのjjを計算する。
jj=1
if(nhc.le.1) go to 6
do 7 i=1,nhc-1
jj=iif(zq.lt.qc(i)) go to 6
7 continue
jj=nhc6 continueczcal=bb0(jj)+bb1(jj)*sqq
zakal(ll)=zcalcc..... update parameters ..... * 誤差分散行列の更新
c* (i-kh)*pcall mati(nx,w1)
call matmul(nx,1,nx,gain,h,w2)
call matsub(nx,nx,w1,w2,w3)
call matmul(nx,nx,nx,w3,pp,w2)c*p(+)
do 111 i=1,nx
do 111 j=1,nx
111 pp(i,j)=w2(i,j)
cc* モデル定数のオンライン更新(jconl=1)
go to ( 21,23,21,23 ),kase
23 continue
go to ( 21,22 ) jconl+1
22 continue
ac1=x(i1)ac2=x(i1+1)c
21 continue
returnページ(20)18program.for.txt
endcc ===============================================
subroutine shoki(qinit,x)! qinit=qq(1)c---------------------------------------------------------c
initial values for implementing kalman filterc---------------------------------------------------------include 'yosokufcj.cmn'
dimension x(253),ca(3)c *******************************************************
c *初期値誤差設定*c *******************************************************c..... initial values of state variables .................
cx(1) : initial discharge (input)
ca(1)=ac1
ca(2)=ac2c *do 300 i=1,n! =(nryu+nkad)*2
x(i)=0.0iii=(i-nryu*2-1)/2+1
gp2=zp2
if(i.gt.nryu*2) gp2=zp4(iii)if(mod(i,2).eq.1) x(i)=qinit**gp2! mm/hr 全地点同じ値で問題なし
300 continue
call wrcal(1,nl,x)c *do 400 i=1,nx
do 400 j=1,nx
pp(i,j) = 0.0
if(j.eq.i) thenif(mod(j,2).eq.1) pp(i,j) = (x(j)*beta)**2.
if(mod(j,2).eq.0) pp(i,j) = pp(i-1,j-1)
end if
400 continue
if(n1.gt.0) thenk=0
do i=i1,i1+n1-1
k=k+1
pp(i,i)=(alph1*ca(k))**2.
if(alph1.gt.900.) pp(i,i)=alpc(k)**2.
end doend ifc *q(i,j) : system error covariancedo 420 i=1,ndo 420 j=1,nq(i,j) = 0.0
420 continue
returnend
cc ===============================================
subroutine mati(n,a)
c* 単位行列の作成
dimension a(253,253)
do 100 i=1,ndo 100 j=1,n
100 a(i,j)=0.
ページ(21)

18program.for.txt
cdo 110 i=1,n
110 a(i,i)=1.0
returnendcc ===============================================
subroutine matt(m,n,a,b)
c* 転値行列の作成
dimension a(253,253),b(253,253)
do 10 i=1,m
do 10 j=1,nb(j,i)=a(i,j)
10 continue
returnendcc ===============================================
subroutine matad(m,n,a,b,c)c* 行列の和
dimension a(253,253),b(253,253),c(253,253)
do 100 i=1,m
do 100 j=1,nc(i,j)=a(i,j)+b(i,j)
100 continue
returnendcc ===============================================
subroutine matc(m,n,a,c,b)c* 行列の定数倍
dimension a(253,253),b(253,253)
do 100 i=1,m
do 100 j=1,n
100 b(i,j)=a(i,j)*c
returnendcc ===============================================
subroutine matmul(l,m,n,a,b,c)c* 行列の積
dimension a(253,253),b(253,253),c(253,253)
do 10 i=1,l
do 20 j=1,nc(i,j)=0.
do 30 k=1,mc(i,j)=c(i,j)+a(i,k)*b(k,j)
30continue
20
continue
10 continue
returnendcc ===============================================
subroutine matsub(m,n,a,b,c)c* 行列の差
dimension a(253,253),b(253,253),c(253,253)
do 100 i=1,m
ページ(22)

18program.for.txt
do 100 j=1,nc(i,j)=a(i,j)-b(i,j)
100 continue
returnendcc ===============================================
subroutine gosa
include 'yosokufcj.cmn'
dimension sa(300,6),u(3),k(3),nrmse(3)ko=1
uo=0.0do i=1,3k(i)=1u(i)=0.0
nrmse(i)=0
end dodo i=1,300
do j=1,6sa(i,j)=0.0
end doend docdo 10 i=1,nq
if(uo.lt.hh0(i)) thenuo=hh0(i)
ko=i
endif
do 10 j=1,3
if(u(j).lt.hf(i,j)) thenu(j)=hf(i,j)k(j)=i+j
endif
10 continue
do 11 j=1,3
do 11 i=j+1,nqsa(i,j)=hh0(i)-hf(i-j,j)if(hh0(i).ge.hlm) then
! hh0>=hlm のみでrmseを算定する
sa(i,j+3)=hh0(i)-hf(i-j,j)nrmse(j)=nrmse(j)+1
endif
11 continuecdo 22 j=1,3
s1=0.0s2=0.0s3=0.0do 20 i=j+1,nqs1=s1+sa(i,j)**2.
s2=s2+abs(sa(i,j)/hh0(i))
s3=s3+sa(i,j+3)**2.
20 continuermse(j)=sqrt(s1/float(nq-j))rmse(j+3)=sqrt(s3/float(nrmse(j)))
ajre(j)=s2/float(nq-j)
ajpe(j)=(u(j)-uo)/uo
jtpe(j)=k(j)-ko
22 continue
ページ(23)

18program.for.txt
returnendcc ===============================================
subroutine qtoh(jj,zq,zh)
include 'yosokufcj.cmn'
jj=1
if(nhc.le.1) go to 263
do 262 i=1,nhc-1
jj=iif(zq.lt.qc(i)) go to 263
262 continue
jj=nhc263 continue
zh=bb0(jj)+bb1(jj)*sqrt(zq)returnendcc ===============================================
c * 各地点の合流定式化と予測地点の観測方程式定式化
subroutine eqsys(nks,nm1,ist0,ist,iryu,icn,kry,*
kka,kkb,kkc,kkd,ihh,p2h,ah,xh,x)include 'yosokufcj.cmn'
dimension x(253),kkb(5)ckkd=0
nm10=mmod(nks)/10+1
nm1=mmod(nks)-mmod(nks)/10*10
if(nm10.eq.ist) go to 200
if(nm10.lt.ist) go to 201
cx 次の次数の支川に移る。
kkb(ist)=kka
ist=ist+1
go to 200
cx 前の次数の支川に戻る。
201 continue
if(nm10.lt.ist0) go to 202
kkb(ist)=kka
ist=ist-1
kka=kkb(ist)go to 200
202 continue
kkd=2
go to 300
200 continue
go to ( 221,222,223,300 ) ,nm1
221 continue! 流域
kry=kry+1
if(kka.gt.0) go to 298
kryu=iryu-kry+1p2h=zp2
ah=area(kryu)
ihh=2*kryu-1
xh=x(ihh)
go to 300
222 continue! 上流端流入量
if(kka.gt.0) go to 298
cx
iw=mwr(nks)ページ(24)

18program.for.txt
p2h=1.0
ah=areak(nks)xh=zr(iw)*3.6/ah! mm/hr
go to 300
223 continue! 河道追跡＆合流計算
kkc=kkc+1
if(kka.gt.0) go to 298
cx
if(kka.gt.0) go to 300
kkad=icn-kkc+1
kka=kka+1p2h=zp4(kkad)
ah=areak(nks)ihh=2*(nryu+kkad)-1xh=x(ihh)
go to 300
298 continue
kkd=1
300 continue
returnendcc ===============================================
subroutine wrcal(ll,k,x)
include 'yosokufcj.cmn'
dimension x(253)c *** 全地点の流出量を計算し、wrに記憶する ***iryu=0
icn=0
do 940 nks=1,nko
na1=mmod(nks)-mmod(nks)/10*10
go to ( 221,940,223,223) , na1
221 continue! 流域
iw=mwr(nks)+1
iryu=iryu+1
k1=2*iryu-1
wr(iw,ll,k)=x(k1)**wp2*area(iryu)/3.6
go to 940
223 continue! 直下流が河道でない合流点または河道
iw=mwr(nks)s=0.0
do 941 i=1,los(nks)jw=lwr(nks,i)s=s+wr(jw,ll,k)
941 continue
wr(iw,ll,k)=sif( na1.eq.4 ) go to 940
iw=mwr(nks)+1
icn=icn+1
k1=2*nryu+2*icn-1
wr(iw,ll,k)=x(k1)**(1./zp4(icn))*areak(nks)/3.6
940 continue
return
end
cx
cx
cx

ページ(25)丸瀬布
3.0

inputfc.txt
FC
複合流域
0.5

H.13. 9.10
10

湧別川
3600

H.12HQ<--nl,DT,xrave,hiq

0.64062.5410<--F0(CK1),Fc0(CK2)

2001
09
10
10
111 111
12
1
1
1
0
0
2
1
3
0
0
3
3
5
2
2
4
1
7
0
0
5
4
9
2
6
6 11 1000
7 13 11
1 11
8 11 1300
9 14 15
2 12
10
4 16
2
9
11
1 17
0
0
12
4 19
2 16
1-R
1-Q
3-Q
1-Gou
4-R
3-Gou
6-R
6-Q
1-ﾘﾕｳｲｷ
2-ﾘﾕｳｲｷ
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.56
0.14
4.00
4.00
4.56
4.14
5.44
5.86
2.56
2.14
3.44
3.86
3.56
3.14
8.00
8.00
7.44
7.86
7.12
6.28
7.12
6.28
4.00
4.00
5.56
5.14
6.00
6.00
5.44
5.86
5.56
5.14
6.00
6.00
5.00
5.00
3.00
3.00
4.00
4.00
4.56
4.14
6.88
7.72
6.44
6.86
6.00
6.00
1.00
1.00
1.00
1.00

1-Ryu
2-Ryu
A-Kado
3-Ryu
1-Gou
4-Ryu
B-Kado
5-Ryu
2-Gou
3-Gou
6-Ryu
4-Gou
2-R

130.17143.80
0.0
82.94
0.0
280.31
0.0
44.18
0.0
0.0
120.600.0
2-Q<--iy,im,id,ih<--nr,nq<--nko
0.
0.
0.
0.
0.
0.
20500.
1.3834
0.6765
0.
0.
0.
0.
0.
0.
0.
0.
0.
7300.
1.5532
0.6642
0.
0.
0.
0.
0.
0.
0.
0.
0.
0.
0.
0.
0.
0.0
0.0
A-IN
A-OT
3-R

B-IN

B-OT

5-R

5-Q

丸瀬布
3-ﾘﾕｳｲｷ
0.00
0.00
0.00
0.30
0.18
0.00
1.00
4.05
3.97
3.67
2.23
2.63
3.51
8.30
7.26
7.18
7.26
4.43
5.51
5.59
4.65
5.88
5.70
4.89
3.47
4.00
5.35
6.07
6.07
6.66
1.42
1.30

4-ﾘﾕｳｲｷ
0.00
0.00
0.00
0.00
0.50
0.00
0.66
4.00
2.64
3.32
2.15
2.83
2.65
8.00
7.85
5.30
5.31
5.01
4.65
6.00
5.34
5.16
6.00
5.00
3.51
4.00
4.66
7.18
6.84
6.51
1.51
1.00

5-ﾘﾕｳｲｷ
0.00
0.00
0.00
0.60
0.47
0.00
1.00
4.07
2.26
1.66
1.34
2.07
2.66
8.60
7.80
5.53
5.85
5.27
4.66
5.27
4.34
5.60
5.41
4.86
4.07
4.00
5.66
6.34
6.34
7.53
2.00
1.59

6-ﾘﾕｳｲｷ
0.00
0.00
0.00
0.21
0.79
0.00
1.00
4.39
3.40
3.19
1.80
2.79
3.40
8.21
6.42
7.98
6.61
4.21
5.40
5.00
4.40
5.61
5.79
4.21
4.00
4.00
5.60
6.00
6.00
6.42
1.60
1.21

0
0
4
0
8
0
0
0
14
15
0
18

ページ(1)

2-Gou

1.00
2.00
2.00
3.00
1.00
3.00
1.56
1.00
1.00
0.56
0.00
1.00
0.56
1.44
1.56
0.56
1.00
1.00
0.56
1.00
0.44
0.56
0.00
0.00
0.44
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00

1.00
2.00
2.00
3.00
1.00
3.00
1.14
1.00
1.00
0.14
0.00
1.00
0.14
1.86
1.14
0.14
1.00
1.00
0.14
1.00
0.86
0.14
0.00
0.00
0.86
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00

1.12
2.35
2.47
3.00
1.42
2.63
2.37
1.00
1.35
1.00
0.42
1.30
1.00
1.49
2.23
1.37
1.35
1.42
1.24
1.00
0.42
1.00
0.35
0.00
0.42
0.00
0.07
0.00
0.30
0.05
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.30
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00

inputfc.txt
1.50
2.00
2.51
3.00
1.51
2.49
2.16
1.00
1.00
0.66
0.51
1.00
0.66
2.35
1.16
1.16
1.00
1.51
0.66
1.00
0.85
0.66
0.00
0.00
0.85
0.00
0.50
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
ページ(2)

1.40
2.66
3.07
3.00
2.00
2.07
2.93
1.00
1.66
1.00
1.00
1.59
1.00
2.34
2.26
1.93
1.66
2.00
1.53
1.00
1.00
1.00
0.66
0.00
1.00
0.00
0.34
0.00
0.60
0.07
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.60
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00

1.39
2.60
3.00
3.00
1.60
2.79
2.21
1.00
1.60
1.00
0.60
1.21
1.00
1.60
2.21
1.21
1.60
1.60
0.81
1.00
0.60
1.00
0.60
0.00
0.60
0.00
0.00
0.00
0.21
0.39
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.21
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00

0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
1 1
0.1
2
26.11
27.23
1
10F8.0174.00174.05174.10176.56
176.66177.83178.02177.78177.65177.00176.98176.60176.52
176.19176.21
175.93175.92
175.76
175.77175.50175.47175.30175.29175.15

inputfc.txt
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
3
1
4
0.1
0.1
0.10
1.135
0
<--NHC H12のH-Q式-173.41-173.48
H13
9
10
10
111

0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.00
0.88

丸瀬布

水位

174.00174.00173.99173.99174.00174.00174.01174.02

174.20174.26174.70175.01

175.39175.80176.20176.40176.73176.83177.00177.18177.39177.52177.59177.70178.24178.29178.35178.28178.21

178.13177.99177.87177.60177.51

177.39177.33177.27177.19177.12177.04176.94176.92176.86

176.77

176.74176.65

176.67176.64176.56176.41

176.36176.35176.27176.21

176.24176.17176.15176.17176.15176.12

176.11176.04176.03175.99175.94175.88175.83175.87175.84175.79175.85175.77

175.70175.66

175.67175.63175.62175.58175.50175.54175.44175.42

175.42

175.41

175.38175.37175.35175.33175.28175.25175.22

175.20175.20175.18175.19175.18

ページ(3)

c**

YosokuFcJ.cmn.txt
yosoku1.cmn **common /var1/ n,n1,n2,nx,nc,i1,i2,i3
common /var2/ kase,jconl,nkse,jysr,iyoso,jkase(4)common /st1/ wp1,wp2,zp2,ac1,ac2,ac3
common /st2/ hx,h2,h3,h4
common /st3/ alph1,alph2,alph3,beta,beta2,alpc(3),ap,bp
common /st5/ ab0(8),ab1(8),bb0(8),bb1(8)common /st6/ hc(8),qc(8),nhc,h0
common /st7/ pp(253,253),q(253,253),ypr(24),yva(24)common /st4/ fmx(253,253),amx(253,253),ax(253,253)
common /st8/ f(253,253),g(253,253)
common /st9/ hlm,rmse(6),ajre(3),ajpe(3),jtpe(3)! 06/01/21
common /outp/ hh0(300),hf(300,24),hu(300,24),hl(300,24)*,zbkal(300),zakal(300),qq(300)common /outpq/ qf(300,24),qu(300,24),ql(300,24),qbkal(300)*,qakal(300)common /time/ kkm(300),kd(300),kh(300)common /date/
iy0,im0,id0,ih0,nr,nq,nl
common /data2/ suma,area(50),arez(50),areak(350),dare(5)common /discha/ r(51,300),qz(300),wr(350,300,20),rave(50),qb
common /mod1/
nko,nryu,nqin,nkad,ngor,nallcommon /mod2/
mmod(160),mwr(160),los(160),lwr(160,2)
common /st10/
ck1,ck2,cc3,ramd,xrave,hiq,dt
common /st11/
cleg(50),alph(50),cmm(50)common /st13/
vk3(50),vk4(50),vp3(50),zp4(50)common /st14/
qd(10,300),qdp(300,10,24),zr(350),rp(50,300,24)

ページ(1)