ファイル読み込み

ファイルの読み込みに関するサブルーチンを記述します。

 do i=1,4
     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”
です。
この二つと、一番下の行に追加される余分な1行を対処するために”breaklinecheck”というルーチンを使います。

これによってblockとelementを出力するサブルーチン”blockelement”を作っています。

下のプログラムを実行すると

$ gfortran main.f90
$ ./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

データを読み込むには?


さて、ブロックの数と要素の数が上のサブルーチンを使うことにより求められることがわかりました。
実際にデータを配列に代入するためにはどうすればいいんでしょう?
型に応じて使うサブルーチンを変えます。
その手続きは下のモジュールを記述することで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

総称名を用いる場合の手続き(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

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です