ファイルの読み込みに関するサブルーチンを記述します。
do i=1,4
do j=1,83
write(30,*)i,j,i*j
end do
write(30,*)
end do
do j=1,83
write(30,*)i,j,i*j
end do
write(30,*)
end do
によってファイル”fort.30″が作られたとします。
今、fort.30を読み込んで
“i”の数”4”
と
“j”の数”83″
を取り出したいとします。
read文を使って読み込みますが、そのまま読み込むと空白部分を読み込んだり、読み込まないだったりします。
ここでは上のdoループによって作られたファイルの場合に使えるものを想定します。
ここでは、
大きな塊を表す数である”4″をblock,
塊の中の要素数を表す”83″をelement
と呼ぶことにします。
この問題を解く戦略は、ファイルを読み込む2種類の方法です。
1つは本当の行数(空行含む)を数え、もう1つは空行を飛ばして読み込む方法です。
本当の行数を数えるサブルーチンは下の”linecount”
であり、
空行を読み飛ばして行数を数えるサブルーチンは下の”linecount_eff”
です。
この二つと、一番下の行に追加される余分な１行を対処するために”breaklinecheck”というルーチンを使います。
これによってblockとelementを出力するサブルーチン”blockelement”を作っています。
下のプログラムを実行すると
$ gfortran main.f90
$ ./a.out
===Apply for fortran file will done===
Nblock :: 4
Nelement :: 83
$ ./a.out
===Apply for fortran file will done===
Nblock :: 4
Nelement :: 83
という結果が得られるかと思います。
program main
!developer => sikinote
!date => 2015/03/31
implicit none
integer::NBlock,Nelement
character(48)::filename
filename='./fort.30'
call blockelement(filename,Nblock,Nelement)
write(6,'(A,i10)')" Nblock ::",Nblock
write(6,'(A,i10)')" Nelement ::",Nelement
stop
end program
!===================================
subroutine blockelement(filename,Nblock,Nelement)
!developer => sikino
!date => 2015/03/31
implicit none
character(*),intent(in)::filename
integer,intent(out)::Nblock,Nelement
integer::c1,c2
call linecount(c1,filename)
call linecount_eff(c2,filename)
call breaklinecheck(c1,c2)
Nblock=c1-c2+1
Nelement=c2/Nblock
return
end subroutine blockelement
!------------------------------
subroutine linecount(c,filename)
implicit none
integer,intent(out)::c
character(*),intent(in)::filename
integer::ier
character(len_trim(filename))::fname
fname=trim(filename)
c=0
open(100,file=fname,status='old',iostat=ier,err=990)
do while(.true.)
read(100,*,end=999)
c=c+1
enddo
999 continue
close(100)
return
!+-----------------------+
990 write(6,'(A)')"!!!!==error when open file",trim(fname),"info-->",ier
write(6,*)"======program stop at linecount"
stop
end subroutine linecount
!--------------------------------
subroutine linecount_eff(c,filename)
implicit none
integer,intent(out)::c
character(*),intent(in)::filename
integer::ier
character(100)::cc
character(len_trim(filename))::fname
fname=trim(filename)
c=0
open(100,file=fname,status='old',iostat=ier,err=990)
do while(.true.)
read(100,*,end=998)cc
if(len_trim(cc).gt.0)c=c+1
enddo
998 continue
close(100)
return
990 write(6,'(A)')"!!!!==error when open file",trim(fname),"info==>",ier
write(6,*)"======program stop at linecount_eff"
stop
end subroutine linecount_eff
!-------------------------------------
subroutine breaklinecheck(c1,c2)
implicit none
integer,intent(inout)::c1
integer,intent(in)::c2
integer::Nb
Nb=c1-c2+1
if(Nb.eq.2.or.mod(c2,Nb).ne.0)then
write(6,*)"===Apply for fortran file will done==="
c1=c1-1
Nb=c1-c2+1
if(mod(c2,Nb).ne.0)then
write(6,*)"line is different(may be last break)"
write(6,*)"program stop at subroutine __breaklinecheck__"
stop
end if
endif
return
end subroutine breaklinecheck
!developer => sikinote
!date => 2015/03/31
implicit none
integer::NBlock,Nelement
character(48)::filename
filename='./fort.30'
call blockelement(filename,Nblock,Nelement)
write(6,'(A,i10)')" Nblock ::",Nblock
write(6,'(A,i10)')" Nelement ::",Nelement
stop
end program
!===================================
subroutine blockelement(filename,Nblock,Nelement)
!developer => sikino
!date => 2015/03/31
implicit none
character(*),intent(in)::filename
integer,intent(out)::Nblock,Nelement
integer::c1,c2
call linecount(c1,filename)
call linecount_eff(c2,filename)
call breaklinecheck(c1,c2)
Nblock=c1-c2+1
Nelement=c2/Nblock
return
end subroutine blockelement
!------------------------------
subroutine linecount(c,filename)
implicit none
integer,intent(out)::c
character(*),intent(in)::filename
integer::ier
character(len_trim(filename))::fname
fname=trim(filename)
c=0
open(100,file=fname,status='old',iostat=ier,err=990)
do while(.true.)
read(100,*,end=999)
c=c+1
enddo
999 continue
close(100)
return
!+-----------------------+
990 write(6,'(A)')"!!!!==error when open file",trim(fname),"info-->",ier
write(6,*)"======program stop at linecount"
stop
end subroutine linecount
!--------------------------------
subroutine linecount_eff(c,filename)
implicit none
integer,intent(out)::c
character(*),intent(in)::filename
integer::ier
character(100)::cc
character(len_trim(filename))::fname
fname=trim(filename)
c=0
open(100,file=fname,status='old',iostat=ier,err=990)
do while(.true.)
read(100,*,end=998)cc
if(len_trim(cc).gt.0)c=c+1
enddo
998 continue
close(100)
return
990 write(6,'(A)')"!!!!==error when open file",trim(fname),"info==>",ier
write(6,*)"======program stop at linecount_eff"
stop
end subroutine linecount_eff
!-------------------------------------
subroutine breaklinecheck(c1,c2)
implicit none
integer,intent(inout)::c1
integer,intent(in)::c2
integer::Nb
Nb=c1-c2+1
if(Nb.eq.2.or.mod(c2,Nb).ne.0)then
write(6,*)"===Apply for fortran file will done==="
c1=c1-1
Nb=c1-c2+1
if(mod(c2,Nb).ne.0)then
write(6,*)"line is different(may be last break)"
write(6,*)"program stop at subroutine __breaklinecheck__"
stop
end if
endif
return
end subroutine breaklinecheck
データを読み込むには？
さて、ブロックの数と要素の数が上のサブルーチンを使うことにより求められることがわかりました。
実際にデータを配列に代入するためにはどうすればいいんでしょう？
型に応じて使うサブルーチンを変えます。
その手続きは下のモジュールを記述することでokです。これを書いた上で、
メインプログラムを以下のように書きます。そうすれば配列x(,)とy(,)に値がはいります。
program main
use read1
implicit none
integer::NBlock,Nelement,i,j
character(48)::filename
double precision,allocatable::x(:,:),y(:,:)
filename='./fort.30'
call blockelement(filename,Nblock,Nelement)
write(6,'(A,i10)')" Nblock ::",Nblock
write(6,'(A,i10)')" Nelement ::",Nelement
allocate(x(1:Nblock,1:Nelement),y(1:Nblock,1:Nelement))
call read_filedata(size(y,1),size(y,2),x,y,filename)
do i=1,Nblock
do j=1,Nelement
write(11,*)x(i,j),y(i,j)
enddo
write(11,*)
enddo
stop
end program
use read1
implicit none
integer::NBlock,Nelement,i,j
character(48)::filename
double precision,allocatable::x(:,:),y(:,:)
filename='./fort.30'
call blockelement(filename,Nblock,Nelement)
write(6,'(A,i10)')" Nblock ::",Nblock
write(6,'(A,i10)')" Nelement ::",Nelement
allocate(x(1:Nblock,1:Nelement),y(1:Nblock,1:Nelement))
call read_filedata(size(y,1),size(y,2),x,y,filename)
do i=1,Nblock
do j=1,Nelement
write(11,*)x(i,j),y(i,j)
enddo
write(11,*)
enddo
stop
end program
総称名を用いる場合の手続き(read_filedata())
module read1
implicit none
interface read_filedata
module procedure &
! dx1 -> double precision array, x(:)
! cy2 -> complex array, y(:,:)
! xyy -> coloum of file, | x y y |
read_dx0_dy1_xy, &
read_dx0_cy1_xyy, &
read_dx1_dy1_xy, &
read_dx1_cy1_xyy, &
read_dx1_dy2_xy, &
read_dx1_cy2_xyy, &
read_dx2_dy2_xy, &
read_dx2_cy2_xyy
end interface read_filedata
contains
subroutine read_dx0_dy1_xy(Ne,y,place,col12)
integer,intent(in)::Ne,col12
character(*),intent(in)::place
double precision,intent(out)::y(1:Ne)
integer::i,ier
double precision::a,b
character(len_trim(place))::fn
y=0d0
fn=trim(place)
open(28,file=fn,status='old',iostat=ier,err=977)
if(col12.eq.1)then
do i=1,Ne
read(28,*)a,b
y(i)=a
enddo
elseif(col12.eq.2)then
do i=1,Ne
read(28,*)a,b
y(i)=b
enddo
else
go to 977
endif
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx0_dy1_11"
stop
end subroutine read_dx0_dy1_xy
subroutine read_dx0_cy1_xyy(Ne,y,place)
integer,intent(in)::Ne
character(*),intent(in)::place
complex(kind(0d0)),intent(out)::y(1:Ne)
integer::i,ier
double precision::a,b,c
character(len_trim(place))::fn
y=0d0
fn=trim(place)
open(28,file=fn,status='old',iostat=ier,err=977)
do i=1,Ne
read(28,*)a,b,c
y(i)=dcmplx(b,c)
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx0_cy1_xyy"
stop
end subroutine read_dx0_cy1_xyy
subroutine read_dx1_dy1_xy(Ne,x,y,place)
integer,intent(in)::Ne
character(*),intent(in)::place
double precision,intent(out)::x(1:Ne),y(1:Ne)
character(len_trim(place))::fn
double precision::a,b
integer::i,ier
x=0d0; y=0d0
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Ne
read(28,*)a,b
x(i)=a
y(i)=b
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx1_dy1_xy"
stop
end subroutine read_dx1_dy1_xy
subroutine read_dx1_cy1_xyy(Ne,x,y,place)
integer,intent(in)::Ne
character(*),intent(in)::place
double precision,intent(out)::x(1:Ne)
complex(kind(0d0)),intent(out)::y(1:Ne)
integer::i,ier
double precision::a,b,c
character(len_trim(place))::fn
y=0d0
fn=trim(place)
open(28,file=fn,status='old',iostat=ier,err=977)
do i=1,Ne
read(28,*)a,b,c
x(i)=a
y(i)=dcmplx(b,c)
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx1_cy1_xyy"
stop
end subroutine read_dx1_cy1_xyy
subroutine read_dx1_dy2_xy(Nb,Ne,x,y,place)
integer,intent(in)::Nb,Ne
double precision,intent(out)::x(1:Ne),y(1:Nb,1:Ne)
character(*),intent(in)::place
integer::i,j,ier
character(len_trim(place))::fn
double precision::a,b
x=0d0; y=0d0
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Nb
do j=1,Ne
read(28,*)a,b
if(i.eq.1)x(j)=a
y(i,j)=b
enddo
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx1_dy2_xy"
stop
end subroutine read_dx1_dy2_xy
subroutine read_dx1_cy2_xyy(Nb,Ne,x,y,place)
integer,intent(in)::Nb,Ne
double precision,intent(out)::x(1:Ne)
complex(kind(0d0)),intent(out)::y(1:Nb,1:Ne)
character(*),intent(in)::place
integer::i,j,ier
character(len_trim(place))::fn
double precision::a,b,c
x=0d0; y=0d0
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Nb
do j=1,Ne
read(28,*)a,b,c
if(i.eq.1)x(j)=a
y(i,j)=dcmplx(b,c)
enddo
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx1_cy2_12"
stop
end subroutine read_dx1_cy2_xyy
subroutine read_dx2_dy2_xy(Nb,Ne,x,y,place)
integer,intent(in)::Nb,Ne
double precision,intent(out)::x(1:Nb,1:Ne),y(1:Nb,1:Ne)
character(*),intent(in)::place
integer::i,j,ier
character(len_trim(place))::fn
double precision::a,b
x=0d0; y=0d0
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Nb
do j=1,Ne
read(28,*)a,b
x(i,j)=a
y(i,j)=b
enddo
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx2_dy2_11"
stop
end subroutine read_dx2_dy2_xy
subroutine read_dx2_cy2_xyy(Nb,Ne,x,y,place)
integer,intent(in)::Nb,Ne
double precision,intent(out)::x(1:Nb,1:Ne)
complex(kind(0d0))::y(1:Nb,1:Ne)
character(*),intent(in)::place
integer::i,j,ier
character(len_trim(place))::fn
double precision::a,b,c
x=0d0; y=dcmplx(0d0,0d0)
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Nb
do j=1,Ne
read(28,*)a,b,c
x(i,j)=a
y(i,j)=dcmplx(b,c)
enddo
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx2_cy2_12"
stop
end subroutine read_dx2_cy2_xyy
end module read1
implicit none
interface read_filedata
module procedure &
! dx1 -> double precision array, x(:)
! cy2 -> complex array, y(:,:)
! xyy -> coloum of file, | x y y |
read_dx0_dy1_xy, &
read_dx0_cy1_xyy, &
read_dx1_dy1_xy, &
read_dx1_cy1_xyy, &
read_dx1_dy2_xy, &
read_dx1_cy2_xyy, &
read_dx2_dy2_xy, &
read_dx2_cy2_xyy
end interface read_filedata
contains
subroutine read_dx0_dy1_xy(Ne,y,place,col12)
integer,intent(in)::Ne,col12
character(*),intent(in)::place
double precision,intent(out)::y(1:Ne)
integer::i,ier
double precision::a,b
character(len_trim(place))::fn
y=0d0
fn=trim(place)
open(28,file=fn,status='old',iostat=ier,err=977)
if(col12.eq.1)then
do i=1,Ne
read(28,*)a,b
y(i)=a
enddo
elseif(col12.eq.2)then
do i=1,Ne
read(28,*)a,b
y(i)=b
enddo
else
go to 977
endif
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx0_dy1_11"
stop
end subroutine read_dx0_dy1_xy
subroutine read_dx0_cy1_xyy(Ne,y,place)
integer,intent(in)::Ne
character(*),intent(in)::place
complex(kind(0d0)),intent(out)::y(1:Ne)
integer::i,ier
double precision::a,b,c
character(len_trim(place))::fn
y=0d0
fn=trim(place)
open(28,file=fn,status='old',iostat=ier,err=977)
do i=1,Ne
read(28,*)a,b,c
y(i)=dcmplx(b,c)
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx0_cy1_xyy"
stop
end subroutine read_dx0_cy1_xyy
subroutine read_dx1_dy1_xy(Ne,x,y,place)
integer,intent(in)::Ne
character(*),intent(in)::place
double precision,intent(out)::x(1:Ne),y(1:Ne)
character(len_trim(place))::fn
double precision::a,b
integer::i,ier
x=0d0; y=0d0
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Ne
read(28,*)a,b
x(i)=a
y(i)=b
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx1_dy1_xy"
stop
end subroutine read_dx1_dy1_xy
subroutine read_dx1_cy1_xyy(Ne,x,y,place)
integer,intent(in)::Ne
character(*),intent(in)::place
double precision,intent(out)::x(1:Ne)
complex(kind(0d0)),intent(out)::y(1:Ne)
integer::i,ier
double precision::a,b,c
character(len_trim(place))::fn
y=0d0
fn=trim(place)
open(28,file=fn,status='old',iostat=ier,err=977)
do i=1,Ne
read(28,*)a,b,c
x(i)=a
y(i)=dcmplx(b,c)
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx1_cy1_xyy"
stop
end subroutine read_dx1_cy1_xyy
subroutine read_dx1_dy2_xy(Nb,Ne,x,y,place)
integer,intent(in)::Nb,Ne
double precision,intent(out)::x(1:Ne),y(1:Nb,1:Ne)
character(*),intent(in)::place
integer::i,j,ier
character(len_trim(place))::fn
double precision::a,b
x=0d0; y=0d0
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Nb
do j=1,Ne
read(28,*)a,b
if(i.eq.1)x(j)=a
y(i,j)=b
enddo
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx1_dy2_xy"
stop
end subroutine read_dx1_dy2_xy
subroutine read_dx1_cy2_xyy(Nb,Ne,x,y,place)
integer,intent(in)::Nb,Ne
double precision,intent(out)::x(1:Ne)
complex(kind(0d0)),intent(out)::y(1:Nb,1:Ne)
character(*),intent(in)::place
integer::i,j,ier
character(len_trim(place))::fn
double precision::a,b,c
x=0d0; y=0d0
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Nb
do j=1,Ne
read(28,*)a,b,c
if(i.eq.1)x(j)=a
y(i,j)=dcmplx(b,c)
enddo
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx1_cy2_12"
stop
end subroutine read_dx1_cy2_xyy
subroutine read_dx2_dy2_xy(Nb,Ne,x,y,place)
integer,intent(in)::Nb,Ne
double precision,intent(out)::x(1:Nb,1:Ne),y(1:Nb,1:Ne)
character(*),intent(in)::place
integer::i,j,ier
character(len_trim(place))::fn
double precision::a,b
x=0d0; y=0d0
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Nb
do j=1,Ne
read(28,*)a,b
x(i,j)=a
y(i,j)=b
enddo
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx2_dy2_11"
stop
end subroutine read_dx2_dy2_xy
subroutine read_dx2_cy2_xyy(Nb,Ne,x,y,place)
integer,intent(in)::Nb,Ne
double precision,intent(out)::x(1:Nb,1:Ne)
complex(kind(0d0))::y(1:Nb,1:Ne)
character(*),intent(in)::place
integer::i,j,ier
character(len_trim(place))::fn
double precision::a,b,c
x=0d0; y=dcmplx(0d0,0d0)
fn=trim(place)
open(28,file=trim(fn),status='old',iostat=ier,err=977)
do i=1,Nb
do j=1,Ne
read(28,*)a,b,c
x(i,j)=a
y(i,j)=dcmplx(b,c)
enddo
enddo
close(28)
return
977 write(6,'(3A,i5)')"!!!!==error when open file",trim(fn),"info==>",ier
write(6,*)"======program stop at read_dx2_cy2_12"
stop
end subroutine read_dx2_cy2_xyy
end module read1
