================
計算からグラフ作成、オープンまでfortranで行う
ある関数のバグを直しているときや、
テストをしながら部品を作っているときに便利。
微修正してはコンパイルー＞実行ー＞gnuplotー＞openを繰り返すことが面倒だと感じたら、以下を使うと便利。
subroutine to_gnuplot(plt_file_name)
character*(*) plt_file_name
integer status,system
status = system("gnuplot "//plt_file_name)
return
end
subroutine to_open(eps_file_name)
character*(*) eps_file_name
integer status,system
status = system("open -a preview "//eps_file_name)
return
end
これは、コンパイルー＞実行ー＞gnuplotー＞open という流れを、fortranコードからshellを操作することによって、コンパイルー＞実行に短縮している。
さらに、fortranから.pltファイルを書き出してやれば、グラフに必要なgnuplotの書式まで生成させることができる。
subroutine dat2open(data_file_name,options)
implicit none
integer status,system,i_unit
character*(*) data_file_name, options
parameter ( i_unit = 91 )
open (i_unit,file="./temp.plt",status="unknown")
write(i_unit,*)"pl '",data_file_name,"' ",options
close(i_unit)
status=system("gnuplot ./temp.plt")
status=system("rm -rf ./temp.plt")
return
end
これは、コンパイルー＞実行ー＞（.plt修正）ー＞gnuplotー＞open を コンパイルー＞実行 へと短縮している。
これまたさらに、shellコマンドの"&&"を使って、
$ test.f -o test.o && ./test.o
とでもすれば、すべてをreturn一発で完了できる。
微修正しながらグラフをとりあえず見たいときには、以上の準備で操作はとっても早くなる。
ファイル番号を自動でふる
パラメータが違う計算を違うファイルに書きたいときに、データファイルの名前にパラメータの値を反映させたいとする。できれば、unit番号も？！
これには、writeを使って、文字列変数にファイルの様に書き込む方法、
implicit none
character str*1
integer n
n = 2
write(str,'(I1)') n
stop
end
を使えば良い。当然これは実数型でも使えて、
implicit none
character str*3
double precision d
d = 2.5d0
write(str,'(F3.1)') d
write(*,'(A)')str
stop
end
となる。ということで、dをまわせば後は楽。
implicit none
character str*3
integer i,nn
double precision d,sd,ed,dd
nn = 3
sd = 0.d0
ed = 5.d0
dd = (ed - sd) / dble(nn)
do i = 0, nn
d = sd + dd * dble(i)
write(str,'(F3.1)') d
open( 10 + i, file="base_d="//str//".dat", status='unknown' )
enddo
do i = 0, nn
close(10+i)
enddo
stop
end
$ ls base_d\=
base_d=0.0.dat base_d=1.7.dat base_d=3.3.dat base_d=5.0.dat
というようになって、いつの間にかユニット番号まで連続生成完了。
ついでに、パラメータの値も配列にしてしまえば、i=1は、d~1.7でunit=11でファイル名は"base_d=1.7.dat"という具合にすべて関連付けできてしまう。
データファイルの名前も、.pltファイルもフォートランから自動で書く
そこまでやるなら全部やってるやつ見せろ。とか言われないか。。。
一応、応用のためのテンプレを晒しておく。
call main()
stop
end
c
subroutine main()
implicit none
integer nk
double precision sk,ek,dk
integer nx
double precision sx,ex,dx
character prog*10
prog = 'test_para2'
nk = 5
sk = 0.d0
ek = 3.d0
dk = (ek - sk) / dble(nk)
nx = 2**10
sx = 0.d0
ex = 5.d0
dx = (ex - sx) / dble(nx)
call roop(prog,
$ nk,sk,ek,dk,nx,sx,ex,dx)
call write_plt(prog,
$ nk,sk,ek,dk,nx,sx,ex,dx)
call to_gnuplot(prog//".plt")
call to_open(prog//".eps")
return
end
c
subroutine roop(prog,
$ nk,sk,ek,dk,
$ nx,sx,ex,dx)
implicit none
character prog*(*)
character str*3
integer ik,nk
double precision k,sk,ek,dk
integer ix,nx
double precision x,sx,ex,dx
do ik = 0, nk
k = sk + dk * dble(ik)
write(str,'(F3.1)') k
open( 10 + ik,
$ file=prog//"_k="//str//".dat", status='unknown' )
enddo
call roop_k(nk,sk,ek,dk,
$ nx,sx,ex,dx)
do ik = 0, nk
close(10+ik)
enddo
return
end
c
subroutine roop_k(nk,sk,ek,dk,
$ nx,sx,ex,dx)
implicit none
integer ik,nk
double precision k,sk,ek,dk
integer ix,nx
double precision x,sx,ex,dx
do ik = 0, nk
k = sk + dk * dble(ik)
call roop_x(ik,k,
$ nx,sx,ex,dx)
enddo
return
end
c
subroutine roop_x(ik,k,
$ nx,sx,ex,dx)
implicit none
integer ik
integer ix,nx
double precision sx,ex,dx
double precision func,x,k
do ix = 0, nx
x = sx + dx * dble(ix)
c call count_time(ix,nx) ! require count_time()
write(10+ik,"(E22.16,' ',E22.16)") x, func(x,k)
enddo
return
end
c
double precision function func(x,k)
implicit none
double precision x,k
func = dexp(-x) * dcos(k*x)
return
end
c
subroutine write_plt(prog,
$ nk,sk,ek,dk,
$ nx,sx,ex,dx)
implicit none
character prog*(*)
integer u/10/
integer ik,nk
double precision k,sk,ek,dk
integer nx
double precision sx,ex,dx
character str*3
open(u,file=prog//".plt",status="unknown")
write(u,*)"set output '"//prog//".eps'"
write(u,*)"set terminal postscript enhanced eps color"
write(u,*)"set title '"//prog//"'"
write(u,*)"set xrange [ ",sx," to ",ex," ]"
write(u,*)"set title ''"
write(u,*)"pl 0 ti 'y=0',\" !"\"
do ik = 0, nk
k = sk + dk*dble(ik)
write(str,'(F3.1)')k
write(u,*)
$ " '"//prog//"_k="//str//".dat'
$ w l lw 3 ti 'k="//str//"',\" !"\"
enddo
write(u,*)" 'dummy' ti ''"
close(u)
return
end
c
subroutine to_gnuplot(plt_file_name)
character*(*) plt_file_name
integer status,system
status = system("gnuplot "//plt_file_name)
return
end
c
subroutine to_open(eps_file_name)
character*(*) eps_file_name
integer status,system
status = system("open -a preview "//eps_file_name)
return
end
終了時間の自動予測
ifortに組み込まれているcpu_time(sec)という関数を使って、プログラムの終了時刻を簡単に予測しようというもの。（’簡単’の意味はいずれわかる）
cpu_time(sec)が呼び出されると、”一回目”はosへ時間（確かエポックだったと思うけど、ここでは差にしか興味が無いので、詳しく知りたい方はマニュアル探してください。）を取りにいって、それを（秒換算で）返してくれる。
”二回目以降”は、一回目との差を返してくる。つまり、一回目呼び出し時から呼び出された瞬間までの経過時間が返される。あとは、何回目かで割れば、それまでの平均ステップ処理速度がわかるので、終了時刻を計算できる。
このような処理を、自分が作ったルーチンの中に忍び込ませて、ループ毎に呼び出させれば良い。
以下は、それように作った、ステップ数と総ステップ数を引数に持つサブルーチン。
c
c this subroutine depend on date_time.sub.f module.
c
subroutine count_time(i,n)
implicit none
integer i,n
integer i100
double precision t,ave_t
integer aft_sec,aft(4),now(4),fin(4),dummy
integer sec_day,sec_hou,sec_min
i100 = i*100/n
if(i100.ne.(i-1)*100/n)then
call cpu_time(t)
ave_t = t / dble(i100)
aft_sec = int( ave_t*dble(100-i*100/n) )
call s2dhmsm(aft_sec,aft)
call get_now_dhms(now)
call sum_dhms(now,aft,fin)
write(*,'(I3,A,8(I2,A))')
$ i100,"% finised and after "
$ , aft(1),"d "
$ , aft(2),"h "
$ , aft(3),"m "
$ , aft(4),"s later complete at "
$ , fin(1),", "
$ , fin(2),", "
$ , fin(3),"' "
$ , fin(4),'".'
endif
return
end
do ix =0, nx
call count_time(ix,nx)
... パラメタxでの何らかの処理 ...
enddo
気付いたと思うけど、これは呼び出された経過時間から直線で外挿して、終了時刻を近似しているので、途中で時間のかかる処理が入るものは、ほとんどあてにならない。だけど、普通にOSでなんか重い処理を走らせたら、処理待ち時間とか出るけど、あれってほとんど当てにならないよね。あれと同じくらいのものがこれで実装できると思えば、易い？
余談ですが、上のやつ１００回も出るのかよ。うぜぇよと思ったら、以下のように１０回に１回表示させればいいw
c
c this subroutine depend on date_time.sub.f module.
c print count down time par 10%
c
subroutine count_time10(i,n)
implicit none
integer i,n
integer i100
double precision t,ave_t
integer aft_sec,aft(4),now(4),fin(4),dummy
integer sec_day,sec_hou,sec_min
i100 = i*100/n
if(i100.ne.(i-1)*100/n)then
call cpu_time(t)
if( mod(i100,10) .eq. 0 )then
ave_t = t / dble(i100)
aft_sec = int( ave_t*dble(100-i*100/n) )
call s2dhmsm(aft_sec,aft)
call get_now_dhms(now)
call sum_dhms(now,aft,fin)
write(*,'(I3,A,8(I2,A))')
$ i100,"% finised and after "
$ , aft(1),"d "
$ , aft(2),"h "
$ , aft(3),"m "
$ , aft(4),"s later complete at "
$ , fin(1),", "
$ , fin(2),", "
$ , fin(3),"' "
$ , fin(4),'".'
endif
endif
return
end
日にち
即席で作った、日にち計算ルーチン。（「どっかの使えよ」と思った方は、どっかの使ってくださいw）
c
c getting and calculating for date_time 6 dimension vector
c ( year, month, day, hour, minute, second)
c
subroutine get_now_6(now)
integer temp(3),now(6)
call itime(temp)
do i = 1, 3
now(i) = temp(i)
enddo
call idate1(now(4), now(5), now(6))
return
end
c
subroutine get_now_week()
c
return
end
c
c getting and calculating for date_time 4 dimension vector
c ( day, hour, minute, second)
c
subroutine get_now_dhms(now)
implicit none
integer now(4)
integer temp(3),dummy
call itime(temp)
call idate1(now(1),dummy,dummy)
now(2) = temp(1)
now(3) = temp(2)
now(4) = temp(3)
return
end
c
subroutine dhms2s(d,h,m,s, sec)
implicit none
integer d,h,m,s,sec
integer aday,ahou,amin
aday = 24*50*60
ahou = 60*60
amin = 60
sec = d*aday + h*ahou + m*amin + s
return
end
c
subroutine dhms2sm(dhms, sec)
implicit none
integer dhms(4),sec
call dhms2s(dhms(1),dhms(2),dhms(3),dhms(4),sec)
return
end
c
subroutine s2dhms(sec, d,h,m,s)
implicit none
integer d,h,m,s,sec
integer aday,ahou,amin
aday = 24*50*60
ahou = 60*60
amin = 60
d = sec / aday
h = ( sec - d*aday ) / ahou
m = ( sec - d*aday - h*ahou ) / amin
s = sec - d*aday - h*ahou - m*amin
return
end
c
subroutine s2dhmsm(sec,dhms)
implicit none
integer dhms(4),sec
call s2dhms(sec,dhms(1),dhms(2),dhms(3),dhms(4))
return
end
c
subroutine sum_dhms(dhms1,dhms2,dhms_out)
implicit none
integer dhms1(4),dhms2(4),sec1,sec2,dhms_out(4)
call dhms2sm(dhms1,sec1)
call dhms2sm(dhms2,sec2)
call s2dhmsm(sec1+sec2,dhms_out)
return
end