포트란 파일 직접 접근(direct access) + MPI 파일 입출력 by 바죠

포트란 direct access 기법이  MPI 환경하에서 유용한 입출력 방식으로 사용되는 한 예를 소개합니다.

포트란 문법에서 파일을 다룰 때, 디폴트는 순차적 (" sequential ") 접근을 의미한다.
읽을 때, 적을 때 마찬가지이다.
아래와 같은 경우, 통상 디폴트 옵션에 따라서  access='sequential' 는 생략하는 경우가 대부분이다.

open(1,file='fort.1',form='formatted',access='sequential')

open(2,file='fort.2',access='direct', recl=8*nnn)
위와 같이 할 경우, 즉 명시적으로 direct 접근을 활용한다고 선언하면, 레코드 길이를 정한 상태에서 데이터에 직접 접근할 수 있다. 즉, 읽고 적을 수 있다. 데이터 부분, 부분별로 적고 읽을 수 있다.
프로그램 실행 중에 데이터를 읽고 적을 수 있다. 데이터는 부분으로 나누어져 있어서 전부일 필요가 없다.

데이터 용량이 클 때, 유용하게 사용할 수 있는 기법이다.
사실상 하나의 배열처럼  프로그램에서 불러서 사용할 수 있다.  

이 편리한 방법은  MPI 환경에서도 여전히 유용하다. 노드간 통신을 수행한 다음 0 번 노드가 파일 적기를 담당할 수 있다.
데이터 용량이 클 경우 노드가 클 수 있다. 하지만, 각 노드에서 적절히 배당된 레코드에 각자 적어 버리면, 나중에 이 단일 파일에 접근할 수 있다. 노드간 통신없이 파일에 적을 수 있다.


노드별로 서로 다른 레코드에 직접 접근해서 각자 데이터를 적고 읽을 수 있다.

                    <----------------------------레코드 길이---------------------------->
1번 레코드 : ㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁ
2번 레코드 : ㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁ
3번 레코드 : ㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁ
4번 레코드 : ㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁ
5번 레코드 : ㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁㅁ
--------
----



!234567890
       program d_access
       implicit none
       include 'mpif.h'
       integer myid, nproc, ierr, iroot, kount
       real*8 time_start,time_end
       integer nsites
       real*8, allocatable :: spin_lattice(:),tspin_lattice(:)
       real*8 before,after
       integer kdum,kk

       call MPI_INIT( ierr )
       call MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
       call MPI_COMM_SIZE( MPI_COMM_WORLD, nproc, ierr )
       if(myid == 0 .and. nproc > 1) print *,  nproc," processes are alive"
       if(myid == 0 .and. nproc ==1) print *,  nproc," process is alive"
       time_start=MPI_WTIME()


       nsites=100

       allocate(spin_lattice(nsites))
       allocate(tspin_lattice(nsites))
       spin_lattice=0.d0
       tspin_lattice=0.d0
       before=float(myid)
       print*, before, myid,' node,in the memory'

       open(97,file='fort.97',access='direct',recl=8*(nsites+1))
       write(97,rec=myid+1) before,(spin_lattice(kdum),kdum=1,nsites)
       close(97)
       call MPI_BARRIER( MPI_COMM_WORLD, ierr )

       if(myid == 0)then   ! -----[   process id = 0
       open(97,file='fort.97',access='direct',recl=8*(nsites+1))
       before=2.d222
       do kk=1,nproc
       read(97,rec=kk) after,(tspin_lattice(kdum),kdum=1,nsites)
       print*, after, kk-1,' node,in the file'
!      if(before > after)then
!      before=after
!      spin_lattice=tspin_lattice
!                        endif
       enddo
       close(97)
!      print*, before,' before'
                     endif    ! -------=== } process id =0


       deallocate(spin_lattice)
       deallocate(tspin_lattice)

       time_end=MPI_WTIME()
       if(myid == 0) then     ! -------=== { process id =0
       write(6,'(4(f14.5,1x,a))') (time_end-time_start),'s', (time_end-time_start)/60.d0,'m', (time_end-time_start)/3600.d0,'h', (time_end-time_start)/3600.d0/24.d0,'d'
                     endif    ! -------=== } process id =0
       call MPI_FINALIZE(ierr)
       stop
       end program d_access


    12.00000000000000                12  node,in the memory
    4.000000000000000                 4  node,in the memory
    13.00000000000000                13  node,in the memory
    8.000000000000000                 8  node,in the memory
    14.00000000000000                14  node,in the memory
    10.00000000000000                10  node,in the memory
    2.000000000000000                 2  node,in the memory
    15.00000000000000                15  node,in the memory
    1.000000000000000                 1  node,in the memory
    11.00000000000000                11  node,in the memory
    9.000000000000000                 9  node,in the memory
    6.000000000000000                 6  node,in the memory
    7.000000000000000                 7  node,in the memory
    3.000000000000000                 3  node,in the memory
    5.000000000000000                 5  node,in the memory
           16  processes are alive
   0.0000000000000000                 0  node,in the memory
   0.0000000000000000                 0  node,in the file
    1.000000000000000                 1  node,in the file
    2.000000000000000                 2  node,in the file
    3.000000000000000                 3  node,in the file
    4.000000000000000                 4  node,in the file
    5.000000000000000                 5  node,in the file
    6.000000000000000                 6  node,in the file
    7.000000000000000                 7  node,in the file
    8.000000000000000                 8  node,in the file
    9.000000000000000                 9  node,in the file
    10.00000000000000                10  node,in the file
    11.00000000000000                11  node,in the file
    12.00000000000000                12  node,in the file
    13.00000000000000                13  node,in the file
    14.00000000000000                14  node,in the file
    15.00000000000000                15  node,in the file
       0.22656 s       0.00378 m       0.00006 h       0.00000 d
    6.000000000000000                 6  node,in the memory
    5.000000000000000                 5  node,in the memory
    1.000000000000000                 1  node,in the memory
    3.000000000000000                 3  node,in the memory
    7.000000000000000                 7  node,in the memory
    2.000000000000000                 2  node,in the memory
    4.000000000000000                 4  node,in the memory
            8  processes are alive
   0.0000000000000000                 0  node,in the memory
   0.0000000000000000                 0  node,in the file
    1.000000000000000                 1  node,in the file
    2.000000000000000                 2  node,in the file
    3.000000000000000                 3  node,in the file
    4.000000000000000                 4  node,in the file
    5.000000000000000                 5  node,in the file
    6.000000000000000                 6  node,in the file
    7.000000000000000                 7  node,in the file
       0.00000 s       0.00000 m       0.00000 h       0.00000 d



---------------------------------------------------

포트란 프로그램 실행 중(on the fly) 특정 파일 지우기는 아래와 같이 실행하면 된다.

       OPEN(11,FILE='del')
       CLOSE(11,STATUS='DELETE')   ! 파일 지우기를 실행함.
 
MPI 인 경우 0 번 노드에서만 지워야한다. 모든 노드가 다 지울 수 없다.

---------------------------------------------------

포트란 프로그램 실행중(on the fly) 특정 파일의 존재를 인식하기는 아래와 같은 방식으로 할 수 있다.
http://docs.hp.com/en/B3908-90002/ch10s53.html


       logical lexist

       inquire(file='fort.11',exist=lexist)
       if(lexist)then
       write(6,*) 'file fort.11 is present. spin_lattice is updated'
       open(11,file='fort.11',form='formatted')
       read(11,*) i,ksave
       if( i /= nsites) then
       write(6,*) 'problem sizes are different', i,nsites
                        stop
                        endif
       if( i == nsites) then
       write(6,*) 'the same size calculation', i,nsites
                        endif
       ksave=ksave+1
       print*, 'ksave ',ksave
       do i=1,nsites
       read(11,*) spin_lattice(i)
       enddo
       close(11)
       tmr=ran1(ksave+iseed)
                 else
       call random_spins(iseed)
                 endif
 
---------------------------------------------------

실행중 (on the fly) 문자열 만들기는 아래와 같이 한다.
참고 싸이트: http://www.sdsc.edu/~tkaiser/f90.html

     character (len=12)tmpstr

 
     write(tmpstr,"(a12)")(c_date(5:8)//c_time(1:4)//".dat") ! // does string concatination
     write(*,*)"name of file= ",tmpstr
     open(14,file=tmpstr)

     name of file= 03271114.dat

Creating a format statement at run time (array of integers and a real)
     ! test_vect is an array that we do not know its length until run time
     nstate=9 ! the size of the array
     write(fstr,'("(",i4,"i1,1x,f10.5)")')nstates
     write(*,*)"format= ",fstr
     write(*,fstr)test_vect,result

     format= (   9i1,1x,f10.5)

Reading from a string
    integer ht,minut,sec
    read(c_time,"(3i2)")hr,minut,sec 

---------------------------------------------------

실험 프로그램을 만들어 보았습니다.
!number to string in fortran
!234567890
       implicit none
       integer i,j,k
       character*92 string
       i=1
       j=22
       k=333
       write(string,'(i1,i2,a4)') i,j,".dat"
       print*, trim(string)
       open(1,file=trim(string),form='formatted')
       close(1)
       write(string,'(i1,i2,i3,a4)') i,j,k,".dat"
       print*, trim(string)
       open(1,file=trim(string),form='formatted')
       close(1)

       stop
       end

./a.out
 122.dat
 122333.dat
FORTRAN STOP

 ls 122.dat 122333.dat
122.dat  122333.dat


!234567890  문자열 붙이기
       implicit none
       integer i,j,k
       character*92 string
       character*92 st1,st2
       i=1
       j=22
       k=333
       write(string,'(i1,i2,a4)') i,j,".dat"
       print*, trim(string)
       open(1,file=trim(string),form='formatted')
       close(1)
       write(string,'(i1,i2,i3,a4)') i,j,k,".dat"
       print*, trim(string)
       open(1,file=trim(string),form='formatted')
       close(1)
       write(st1,'(i1,i2,i3)') i,j,k
       print*, trim(st1)
       st2='.dat'
       print*, trim(st2)
       string=trim(st1)//trim(st2)
       print*, trim(string)
       stop
       end

 122.dat
 122333.dat
 122333
 .dat
 122333.dat
FORTRAN STOP
      character*10 function itochar(i)
! Returns a character string with a copy of input integer
! with spaces filling on the right, if the integer
! has less than 10 digits.
!
! P. Ordejon, July 2003
      implicit none
      integer i, io, idiv, itest, iascii, ipos, iscan, nvac
      logical null
      character char*10

      null=.true.
      nvac=0
      io=i
      do iscan = 9, 0, -1
        idiv = 10**iscan
        itest = io/idiv
        iascii = itest+48
        ipos = 10-iscan
        if (null) then
          if (achar(iascii) .eq. '0') then
            nvac = nvac + 1
            goto 10
          else
            null = .false.
          endif
        endif
        char(ipos:ipos) = achar(iascii)
10      continue
        io = io - itest*idiv
      enddo
      if (nvac .eq. 0)  then
        itochar = char
      else
        itochar(10-nvac+1:10) = ' '
        itochar(1:10-nvac) = char(nvac+1:10)
      endif
      end

---------------------------------------------------

 
참고:

http://incredible.egloos.com/3044815


--------------------------------------------------------------------------------------------------------------------

cat Direct1.f
integer u/4/, v /5/, w /6/, x /7/, y /8/, z /9/
open( 1, access='DIRECT', recl=8 )
write( 1, rec=1 ) u, v
write( 1, rec=2 ) w, x
write( 1, rec=3 ) y, z
end

cat Direct2.f
integer u, v, w, x, y, z
open( 1, access='DIRECT', recl=8 )
read( 1, rec=1 ) u, v
read( 1, rec=2 ) w, x
read( 1, rec=3 ) y, z
write(*,*) u, v, w, x, y, z
end

cat Direct3.f
integer u, v, w, x, y, z
open( 1, access='DIRECT', recl=1 )
read( 1, rec=1 ) u, v, w
read( 1, rec=13 ) x, y, z
write(*,*) u, v, w, x, y, z
end
https://docs.oracle.com/cd/E19957-01/805-4939/z40007437ace/index.html



--------------------------------------------------------------------------------------------------------------------

       j1=maxnatoms
       inquire(iolength=ipar) ((geoinv_set(ipar,j0),ipar=1,npar),j0=1,j1),   &
                              ((xgeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1),  &
                              ((ygeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1),  &
                              ((zgeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1),  &
                              ((xxgeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1), &
                              ((yygeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1), &
                              ((zzgeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1), &
                              ((xygeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1), &
                              ((yzgeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1), &
                              ((zxgeoinv_set(ipar,j0),ipar=1,npar),j0=1,j1)

--------------------------------------------------------------------------------------------------------------------

http://incredible.egloos.com/3755171




----------------------------------------------------------------------------

!234567890
       subroutine readnext_r8(string, ipos, r8value)
       implicit none
       character(len=*), intent(in)    :: string
       integer,          intent(inout) :: ipos
       real*8,           intent(out)   :: r8value
       integer                         :: i1, i2

       i2 = len_trim(string)
!      initial r8value:
       if (ipos > i2) then
         ipos   = 0
         r8value = 0.0d0
         return
       end if
!      skip blanks:
       i1 = ipos
       do
        if (string(i1:i1) /= ' ') exit
        i1 = i1 + 1
       end do
!      read real r8value and set ipos:
       read(string(i1:i2), *) r8value
       ipos = scan(string(i1:i2), ' ')
       if (ipos == 0) then
          ipos = i2 + 1
       else
          ipos = ipos + i1 - 1
       end if
       end subroutine readnext_r8
!234567890
       subroutine readnext_i4(string, ipos, i4value)
       implicit none
       character(len=*), intent(in)    :: string
       integer,          intent(inout) :: ipos
       integer,          intent(out)   :: i4value
       integer                         :: i1, i2

       i2 = len_trim(string)
!      initial i4value:
       if (ipos > i2) then
         ipos   = 0
         i4value = 0
         return
       end if
!      skip blanks:
       i1 = ipos
       do
        if (string(i1:i1) /= ' ') exit
        i1 = i1 + 1
       end do
!      read real i4value and set ipos:
       read(string(i1:i2), *) i4value
       ipos = scan(string(i1:i2), ' ')
       if (ipos == 0) then
          ipos = i2 + 1
       else
          ipos = ipos + i1 - 1
       end if
       end subroutine readnext_i4
!234567890
       subroutine readnext_c(string, ipos, char1)
       implicit none
       character(len=*), intent(in)    :: string
       integer,          intent(inout) :: ipos
       character(len=*), intent(out)   :: char1
       integer                         :: i1, i2

       i2 = len_trim(string)
!      initial char1:
       if (ipos > i2) then
         ipos   = 0
         char1 =' '
         return
       end if
!      skip blanks:
       i1 = ipos
       do
        if (string(i1:i1) /= ' ') exit
        i1 = i1 + 1
       end do
!      read real char1 and set ipos:
       read(string(i1:i2), *) char1
       char1=adjustl(char1)
       char1=trim(char1)
       ipos = scan(string(i1:i2), ' ')
       if (ipos == 0) then
          ipos = i2 + 1
       else
          ipos = ipos + i1 - 1
       end if
       end subroutine readnext_c
!234567890
       program aaa
       implicit none
       integer i,ipos
       real*8 tmv(30)
       integer itmv(30)
       character*280 char1(30)
       character*280 string

       string=' 10   20   30  '
       ipos=1
       do i=1,4
       call readnext_i4(string, ipos, itmv(i))
       write(6,*) itmv(i),kind(itmv(i))
       enddo


       string=' 10.   2.0   .30  '
       ipos=1
       do i=1,4
       call readnext_r8(string, ipos, tmv(i))
       write(6,*) tmv(i),kind(tmv(i))
       enddo

       string=' a  bc  def   20   30  '
       ipos=1
       do i=1,4
       call readnext_c(string, ipos, char1(i))
       write(6,*) trim(char1(i)),kind(char1(i))
       enddo

       end program aaa
ifort -warn unused z.f90
[ihlee@KRISS-TUCANA a7]$ ./a.out
          10           4
          20           4
          30           4
           0           4
   10.0000000000000                8
   2.00000000000000                8
  0.300000000000000                8
  0.000000000000000E+000           8
 a           1
 bc           1
 def           1
 20           1

----------------------------------------------------------------------------


핑백

덧글

댓글 입력 영역

최근 포토로그