Contents
自分用 Tips です．入出力関係および小さなサンプルプログラムを載せています．
入出力関係サンプルプログラム
module defpi
implicit none
real(8),parameter::pi=3.14159265358979323846D0
end module defpi
program f90_for_basic
use defpi
implicit none
integer,parameter::nn=1000,mm=100
character(len=50)::fnameR
character(len=50)::fnameW
character(len=50)::filename
character(len=50)::dummy
character(len=20)::str(1:nn)
character(len=200)::strcom
character(len=200)::linebuf
integer::i,io,nd,j,ndata
real(8),allocatable::datax(:)
call getarg(1,dummy)
call getarg(2,fnameR)
call getarg(3,fnameW)
!character to numeric value
read(dummy,*) ndata
allocate(datax(1:ndata))
call random_number(datax)
open(11,file=fnameR,status='old')
read(11,'(a)') strcom
do i=1,nn
read(11,*,iostat=io) str(i)
if(io<0)exit
end do
close(11)
nd=i-1
!replace '_' (under bar) to ' ' (space)
do i=1,nd
dummy=str(i)
call rep_ub(dummy)
str(i)=dummy
end do
do i=1,nd
write (filename,'("_test_",i2.2,".txt")') i
open(13,file=filename,status='replace')
write(13,'(a)') trim(adjustl(strcom))
write(13,'(a)') trim(adjustl(str(i)))
linebuf='data'
do j=1,ndata
!numeric value to character
write(dummy,'(",",e15.7)') datax(j)
linebuf=trim(adjustl(linebuf))//dummy
write(6,*) j,datax(j),dummy
end do
!delete of space
call del_spaces(linebuf)
write(13,'(a)') trim(adjustl(linebuf))
close(13)
end do
open(12,file=fnameW,status='replace')
write(12,'(a)') trim(adjustl(strcom))
do i=1,nd
linebuf=''
do j=1,ndata
!numeric value to character
write(dummy,'(",",e15.7)') datax(j)
linebuf=trim(adjustl(linebuf))//dummy
end do
!delete of space
call del_spaces(linebuf)
write(12,'(a)') trim(adjustl(str(i)))//trim(adjustl(linebuf))
end do
close(12)
stop
contains
subroutine del_spaces(s)
character (*), intent (inout) :: s
character (len=len(s)) tmp
integer i, j
j = 1
do i = 1, len(s)
if (s(i:i)==' ') cycle
tmp(j:j) = s(i:i)
j = j + 1
end do
s = tmp(1:j-1)
end subroutine del_spaces
subroutine rep_ub(s)
!Replaceing underbar with space
character (*), intent (inout) :: s
integer i
do i = 1, len(s)
if (s(i:i)=='_') s(i:i)=' '
end do
end subroutine rep_ub
end program f90_for_basic
module による pi の定義
- pi などプログラム内で共通で用いる定数などは，module で定義しておきます．
- ここでは pi の値は C 言語の math.h に定義されている M_PI の値を用いています．
- module を使う場合は，プログラム本体で implicit none の前に use により module 名を記述します．
module defpi implicit none real(8),parameter::pi=3.14159265358979323846D0 end module defpi program f90_for_basic use defpi implicit none ..... ..... ..... end program f90_for_basic
コマンドラインからの入力
- gfortran で使える機能です．
- プログラム本体で組み込みサブルーチン getarg() を用いることにより，コマンドラインから文字列を読み込みます．
call getarg(1,dummy) call getarg(2,fnameR) call getarg(3,fnameW)
実行用スクリプトの事例は以下のとおり．
./f90_for_basic 4 inp_dat.txt out_dat.txt
| 実行プログラム：f90_for_basic |
| dummy=4 |
| fnameR=inp_dat.txt |
| fnameW=out_dat.txt |
文字列を数値に変換
文字変数 dummy に格納されている文字列を，数値変数 ndata に変換します．
read(dummy,*) ndata
行数不明のファイルからの読み込み
- ファイル fnameR に格納されたデータの行数が不明の場合，iostat を用いて eof を検知し，ループから抜けます．
- 整数変数 io の値は以下のとおり．なお整数変数 io の宣言を忘れないように！
| io | 0 | 負値 | 正値 |
|---|---|---|---|
| 意味 | 正常 | eof | エラー |
- 下の事例では，nn を予想されるデータ行数より確実に大きい値として，do ループを用いています．
- ループを抜けた後，行数を整数変数 nd に格納します．
open(11,file=fnameR,status='old') read(11,'(a)') strcom do i=1,nn read(11,*,iostat=io) str(i) if(io<0)exit end do close(11) nd=i-1
アンダーバーを空白に変換
- 入力を csv ファイルから行う場合でも，Fortran では空白が含まれているとそれをデータ区切りとして認識します． このため数値と 'Surge Tank' のような空白を含む文字列が1行に存在する場合，予め空白をアンダーバーにしておき， あとから空白に置き換える方が便利な場合があります．
- このため，アンダーバーを空白に変換するサブルーチンを作りました．(例：This_is_a_pen. => This is a pen.)
- サブルーチンは以下のとおり．
subroutine rep_ub(s) character (*), intent (inout) :: s integer i do i = 1, len(s) if (s(i:i)=='_') s(i:i)=' ' end do end subroutine rep_ub
使用法は以下のとおり．str(i) に格納された文字列を，文字列変数 dummy にコピーし，サブルーチン rep_ub( ) を呼びます． 処理完了後，書き換えられた文字列変数 dummy を str(i) にコピーします．
do i=1,nd dummy=str(i) call rep_ub(dummy) str(i)=dummy end do
連番ファイルの生成と書き込み
- do 文の中で，連番ファイルを生成します．
- ここでのファイル名は，_test_01.txt, _test_02.txt, _test_03.txt, ... という形でつけられ， ファイル名をしめす文字列変数 filename に格納され使用されます．
do i=1,nd
write (filename,'("_test_",i2.2,".txt")') i
open(13,file=filename,status='replace')
.....
.....
close(13)
end do
csv ファイルの書き出し
- 装置番号 12 で新規ファイル fnameW を生成しデータを書き込みます．
- ここでは数値 datax(j) を コンマ(,)付き e15.7 で，文字列変数 dummy に書き込み，これを連結していきます．
- 書き込み時は，adjustl( ) で左詰めにし，trim( ) で右側の空白を出力しないようにします．
- サブルーチン del_spaces( ) は，次項目で紹介している「文字列に含まれる全ての空白を削除する」サブルーチンです．
- write(6,'(a)') のように装置番号を 6 とすれば，通常は画面出力になり，途中経過監視などに使えます．
open(12,file=fnameW,status='replace')
write(12,'(a)') trim(adjustl(strcom))
do i=1,nd
linebuf=''
do j=1,ndata
write(dummy,'(",",e15.7)') datax(j)
linebuf=trim(adjustl(linebuf))//dummy
end do
call del_spaces(linebuf)
write(12,'(a)') trim(adjustl(str(i)))//trim(adjustl(linebuf))
end do
close(12)
文字列に含まれる全ての空白を削除する
- 「csv ファイルの書き出し」で示したように，出力を csv 形式で行う場合，文字列に含まれる空白を削除したい場合があります． こ場合に以下のサブルーチンが利用できます．
- このサブルーチンは 'nag Fortran入門' (www.nag-j.co.jp/fortran/index.html) に掲載されているものを使用させていただいております．
- 使用法は，削除したい空白を含む文字列をサブルーチン del_spaces( ) に渡すだけです．
- write 文の中では trim( ) を用いて右側の空白を出力しないようにします．
subroutine del_spaces(s) character (*), intent (inout) :: s character (len=len(s)) tmp integer i, j j = 1 do i = 1, len(s) if (s(i:i)==' ') cycle tmp(j:j) = s(i:i) j = j + 1 end do s = tmp(1:j-1) end subroutine del_spaces
乱数
Fortran の組み込みサブルーチン random_number による一様乱数発生と，これを用いた Box−Muller 法による正規乱数発生プログラムのサンプルです． random_seed の使い方のサンプルも兼ねています．結構面倒ですね．
module defpi
implicit none
real(8),parameter::pi=atan(1.0D0)*4.0D0
end module defpi
program f90_random
use defpi
implicit none
integer,parameter::nd=100000
real(8)::datax(1:nd),datay(1:nd)
real(8)::z1,z2
integer::i
integer::clock
integer::nrand
integer,allocatable::seed(:)
call random_seed(size=nrand)
allocate(seed(nrand))
call system_clock(count=clock)
seed=clock
call random_seed(put=seed)
call random_number(datax)
i=0
do
call BMM(z1,z2)
i=i+1;datay(i)=z1
if(i==nd)exit
i=i+1;datay(i)=z2
if(i==nd)exit
end do
open(12,file='_rand.txt',status='replace')
do i=1,nd
write(12,'(2(e15.7))') datax(i),datay(i)
end do
close(12)
stop
contains
subroutine BMM(z1,z2)
!Box-Muller's method
real(8),intent(out)::z1,z2
real(8)::x,y
call random_number(x)
call random_number(y)
z1=sqrt(-2.0D0*log(x))*cos(2.0D0*pi*y)
z2=sqrt(-2.0D0*log(x))*sin(2.0D0*pi*y)
end subroutine BMM
end program f90_random
配列中の最小値とその位置 (minval & minloc)
Fortran95 の組み込み関数ですが，便利そうなので使用例を示すプログラムを作りました． 最大値とその位置についても，maxval と maxloc により同様に検索することができます．
program f90_minmax
!Use of minval and minloc (Fortran95)
implicit none
integer,parameter::n=10,m=3
integer::i,j
real(8)::x(1:n,1:m)
real(8)::min0,min1(1:m),min2(1:n)
integer::loc0(1:2),loc1(1:m),loc2(1:n)
do j=1,m
call random_number(x(1:n,j))
end do
min0=minval(x) !Minimum of all elements
min1(:)=minval(x,1) !Minimum of each row
min2(:)=minval(x,2) !Minimum of each column
loc0(:)=minloc(x) !Location of minimum value (given 2 values of row and column)
loc1(:)=minloc(x,1) !Location of minimum value in each column
loc2(:)=minloc(x,2) !Location of minimum value in cach row
write(6,'(a5,3(a6),"|",a6,a4)') 'No','x(,1)','x(,2)','x(,3)','min','loc'
do i=1,n
write(6,'(i5,3(f6.3),"|",f6.3,i4)') i,(x(i,j),j=1,m),min2(i),loc2(i)
end do
write(6,'(a)') '---------------------------------'
write(6,'(a5,3(f6.3),"|",f6.3)') 'min',(min1(j),j=1,m),min0
write(6,'(a5,3(i6),"|",i2,",",i2)') 'loc',(loc1(j),j=1,m),loc0(1),loc0(2)
! Result
! No x(,1) x(,2) x(,3)| min loc
! 1 0.998 0.218 0.856| 0.218 2
! 2 0.567 0.133 0.401| 0.133 2
! 3 0.966 0.901 0.207| 0.207 3
! 4 0.748 0.387 0.969| 0.387 2
! 5 0.367 0.445 0.598| 0.367 1
! 6 0.481 0.662 0.673| 0.481 1
! 7 0.074 0.016 0.457| 0.016 2
! 8 0.005 0.651 0.330| 0.005 1
! 9 0.347 0.646 0.100| 0.100 3
! 10 0.342 0.323 0.755| 0.323 2
!---------------------------------
! min 0.005 0.016 0.100| 0.005
! loc 8 7 9| 8, 1
end program f90_minmax
計算時間の取得
組み込みサブルーチン system_clock を用いて，計算時間を取得するプログラムです． 参考に，Fortran95 の組み込みサブルーチン cpu_time を用いた事例も載せてみました．
program f90_time
implicit none
real(8)::t1,t2,ttmax
write(6,*) 'system_clock'
t1=DIFT(ttmax)
write(6,*) t1,ttmax
call work()
t2=DIFT(ttmax)
write(6,*) t2,ttmax
write(6,*) t2-t1
write(6,*) 'cpu_time'
call cpu_time(t1)
write(6,*) t1
call work()
call cpu_time(t2)
write(6,*) t2
write(6,*) t2-t1
stop
contains
real(8) function DIFT(ttmax)
real(8),intent(out)::ttmax
integer::count,count_rate,count_max
call system_clock(count,count_rate,count_max)
ttmax=real(count_max)/real(count_rate)
DIFT=real(count)/real(count_rate)
end function DIFT
subroutine WORK()
integer::i
real(8)::s
s=1.0D0
do i=1,20000000
s=s*sin(s)+cos(s)
end do
end subroutine WORK
end program f90_time
年月日時刻の取得
組み込みサブルーチン DATE_AND_TIME を用いて，年月日時刻を取得するプログラムです．
program f90_date
implicit none
character(len=50)::datime
datime=CALLDATE()
write(6,*) datime
stop
contains
character(len=50) function CALLDATE()
character(len=8) ::date
character(len=10)::time
character(len=5) ::zone
integer::values(1:8)
integer::i
character(len=4) ::ye
character(len=4) ::da
character(len=10)::mo
character(len=5) ::ti
character(len=10)::str
character(len=50)::datime
call DATE_AND_TIME(date,time,zone,values)
write(6,*) 'date=',date
write(6,*) 'time=',time
write(6,*) 'zone=',zone
do i=1,8
write(6,'(a7,i1,a2,i4)') 'values(',i,')=',values(i)
end do
ye=date(1:4)
mo=date(5:6)
da=date(7:8)
ti=time(1:2)//':'//time(3:4)
select case(mo)
case('01');mo='Jan'
case('02');mo='Feb'
case('03');mo='Mar'
case('04');mo='Apl'
case('05');mo='May'
case('06');mo='Jun'
case('07');mo='Jul'
case('08');mo='Aug'
case('09');mo='Sep'
case('10');mo='Oct'
case('11');mo='Nov'
case('12');mo='Dec'
end select
CALLDATE=trim(adjustl(da))//' '//trim(adjustl(mo))//' '//trim(adjustl(ye))//' at '//trim(adjustl(ti))
end function CALLDATE
end program f90_date
実行結果の事例は，以下の通り．
date=20150319 time=134504.529 zone=+0800 values(1)=2015 values(2)= 3 values(3)= 19 values(4)= 480 values(5)= 13 values(6)= 45 values(7)= 4 values(8)= 529 19 Mar 2015 at 13:45
バブルソート
遅いことは承知の上で，最も基本となるソートである，「バブルソート」のプログラムを載せました．
program f90_bsort
implicit none
integer,parameter::nd=10
real(8)::data(1:nd)
integer::i
call random_number(data)
call BSORT(nd,data)
do i=1,nd
write(6,*) data(i)
end do
stop
contains
subroutine BSORT(n,x)
integer,intent(in)::n
real(8),intent(inout)::x(:)
integer::i,j
real(8)::work
do i=1,n
do j=i+1,n
if(x(i)>x(j))then
work=x(i)
x(i)=x(j)
x(j)=work
end if
end do
end do
end subroutine BSORT
end program f90_bsort