Fortran Tips

================

計算からグラフ作成、オープンまでfortranで行う
---------------------------------------------

ある関数のバグを直しているときや、
テストをしながら部品を作っているときに便利。
微修正してはコンパイルー＞実行ー＞gnuplotー＞openを繰り返すことが面倒だと感じたら、以下を使うと便利。

```fortran

      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の書式まで生成させることができる。

```fortran

      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コマンドの"&&"を使って、

```bash
  $ test.f -o test.o && ./test.o
```

とでもすれば、すべてをreturn一発で完了できる。
微修正しながらグラフをとりあえず見たいときには、以上の準備で操作はとっても早くなる。

ファイル番号を自動でふる
---------------------------------------------

パラメータが違う計算を違うファイルに書きたいときに、データファイルの名前にパラメータの値を反映させたいとする。できれば、unit番号も？！


これには、writeを使って、文字列変数にファイルの様に書き込む方法、

```fortran

    implicit none
    character str*1
    integer n
    n = 2
    write(str,'(I1)') n
    stop
    end
```

を使えば良い。当然これは実数型でも使えて、

```fortran

      implicit none
      character str*3
      double precision d
      d = 2.5d0
      write(str,'(F3.1)') d

      write(*,'(A)')str
      stop
      end
```

となる。ということで、dをまわせば後は楽。

```fortran

      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
```

```bash
    $ 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ファイルもフォートランから自動で書く
-----------------------------------------------------------------------------------------

そこまでやるなら全部やってるやつ見せろ。とか言われないか。。。
一応、応用のためのテンプレを晒しておく。

```fortran

      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
```

![test_para2](http://f.cl.ly/items/0j3p382N290y270T2D1Q/test_para2.png)

終了時間の自動予測
---------------------------------------------

ifortに組み込まれているcpu_time(sec)という関数を使って、プログラムの終了時刻を簡単に予測しようというもの。（’簡単’の意味はいずれわかる）

cpu_time(sec)が呼び出されると、”一回目”はosへ時間（確かエポックだったと思うけど、ここでは差にしか興味が無いので、詳しく知りたい方はマニュアル探してください。）を取りにいって、それを（秒換算で）返してくれる。
”二回目以降”は、一回目との差を返してくる。つまり、一回目呼び出し時から呼び出された瞬間までの経過時間が返される。あとは、何回目かで割れば、それまでの平均ステップ処理速度がわかるので、終了時刻を計算できる。

このような処理を、自分が作ったルーチンの中に忍び込ませて、ループ毎に呼び出させれば良い。
以下は、それように作った、ステップ数と総ステップ数を引数に持つサブルーチン。

```fortran

    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
```

```fortran
    do ix =0, nx
       call count_time(ix,nx)
       ... パラメタxでの何らかの処理 ...
    enddo
```

気付いたと思うけど、これは呼び出された経過時間から直線で外挿して、終了時刻を近似しているので、途中で時間のかかる処理が入るものは、ほとんどあてにならない。だけど、普通にOSでなんか重い処理を走らせたら、処理待ち時間とか出るけど、あれってほとんど当てにならないよね。あれと同じくらいのものがこれで実装できると思えば、易い？

余談ですが、上のやつ１００回も出るのかよ。うぜぇよと思ったら、以下のように１０回に１回表示させればいいw

```fortran

    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）

```fortran

    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
```