숫자로 된 파일 이름들 (포트란) number2string by 바죠

포트란에서 출력 파일들을 여러개로 만들 수 있다. 기본 출력이외에 따로 모셔 둘 데이터가 있을 수 있다는 말씀이다. 이러한 경우, 각각에 대해서 미리 이름을 만들어 줄 수 있다.
즉,
open(1, file='abc', form='formatted')

여기서 이야기 하려고 하는것은 숫자로 파일 이름을 대체하고 싶을 때이다.
다시 말해서, 1이 스트링이 되어야 한다. 파일 이름으로 사용될 수 있는 스트링.

셀에서도 숫자를 아래와 같이 4자리수로 설정할 수 있다.
printf -v ntag "%04d" $kounter
cp ../POSCAR_$ntag  ./POSCAR


!234567890
implicit none
integer num,isize
character*8 string
character*8 fname
integer ii,jj,kk

isize=1
num=199

do jj=0,10
num=jj
call numeral (num,string,isize)
write(6,'(a(isize))') string
fname=string
open(1,file=fname,form='formatted')
write(1,*) isize, num
close(1)
enddo

stop
end




c
c
c ###################################################
c ## COPYRIGHT (C) 1992 by Jay William Ponder ##
c ## All Rights Reserved ##
c ###################################################
c
c #############################################################
c ## ##
c ## subroutine numeral -- convert number to text string ##
c ## ##
c #############################################################
c
c
c "numeral" converts an input integer number into the
c corresponding right- or left-justified text numeral
c
c number integer value of the number to be transformed
c string text string to be filled with corresponding numeral
c size on input, the minimal acceptable numeral length, if
c zero then output will be right justified, if
c nonzero then numeral is left-justified and padded
c with leading zeros as necessary; upon output, the
c number of non-blank characters in the numeral
c
c
      subroutine numeral (number,string,size)
      implicit none
      integer i,number,size,multi,pos
      integer length,minsize,len
      integer million,hunthou,tenthou
      integer thousand,hundred,tens,ones
      character*1 digit(0:9)
      character*(*) string
      logical right,negative
      data digit / '0','1','2','3','4','5','6','7','8','9' /
c
c
c     set justification and size bounds for numeral string
c
      if (size .eq. 0) then
         right = .true.
         size = 1
      else
         right = .false.
      end if
      minsize = size
      length = len(string)
c
c     test the sign of the original number
c
      if (number .ge. 0) then
         negative = .false.
      else
         negative = .true.
         number = -number
      end if
c
c     use modulo arithmetic to find place-holding digits
c
      million = number / 1000000
      multi = 1000000 * million
      hunthou = (number-multi) / 100000
      multi = multi + 100000*hunthou
      tenthou = (number-multi) / 10000
      multi = multi + 10000*tenthou
      thousand = (number-multi) / 1000
      multi = multi + 1000*thousand
      hundred = (number-multi) / 100
      multi = multi + 100*hundred
      tens = (number-multi) / 10
      multi = multi + 10*tens
      -nes = number - multi
c
c     find the correct length to be used for the numeral
c
      if (million .ne. 0) then
         size = 7
      else if (hunthou .ne. 0) then
         size = 6
      else if (tenthou .ne. 0) then
         size = 5
      else if (thousand .ne. 0) then
         size = 4
      else if (hundred .ne. 0) then
         size = 3
      else if (tens .ne. 0) then
         size = 2
      else
         size = 1
      end if
      size = min(size,length)
      size = max(size,minsize)
c
c     convert individual digits to a string of numerals
c
      if (size .eq. 7) then
         string(1:1) = digit(million)
         string(2:2) = digit(hunthou)
         string(3:3) = digit(tenthou)
         string(4:4) = digit(thousand)
         string(5:5) = digit(hundred)
         string(6:6) = digit(tens)
         string(7:7) = digit(ones)
      else if (size .eq. 6) then
         string(1:1) = digit(hunthou)
         string(2:2) = digit(tenthou)
         string(3:3) = digit(thousand)
         string(4:4) = digit(hundred)
         string(5:5) = digit(tens)
         string(6:6) = digit(ones)
      else if (size .eq. 5) then
         string(1:1) = digit(tenthou)
         string(2:2) = digit(thousand)
         string(3:3) = digit(hundred)
         string(4:4) = digit(tens)
         string(5:5) = digit(ones)
      else if (size .eq. 4) then
         string(1:1) = digit(thousand)
         string(2:2) = digit(hundred)
         string(3:3) = digit(tens)
         string(4:4) = digit(ones)
      else if (size .eq. 3) then
         string(1:1) = digit(hundred)
         string(2:2) = digit(tens)
         string(3:3) = digit(ones)
      else if (size .eq. 2) then
         string(1:1) = digit(tens)
         string(2:2) = digit(ones)
      else
         string(1:1) = digit(ones)
      end if
c
c     right-justify if desired, and pad with blanks
c
      if (right) then
         do i = size, 1, -1
            pos = length - size + i
            string(pos:pos) = string(i:i)
         end do
         do i = 1, length-size
            string(i:i) = ' '
         end do
      else
         do i = size+1, length
            string(i:i) = ' '
         end do
      end if
      return
      end

 

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

계산중 파일에 정보를 적는 방법

대부분의 출력에서는 사람이 볼수 있는 형식으로 작성하게된다. 하지만, 데이터가 복잡하고 너무 많다고 생각이 들경우에는 unformatted form으로 작성할 수 있다. 이 경우 디스크 용량을 적게 잡아 먹는 대신 사람이 읽어 볼 수 없다는 점이 특징이 있다. 컴퓨터가 읽고 적는 속도면에서 유리하다. 이러한 데이터를 읽어 내고 싶을 때에는 적은 순서 그대로 읽어 내어야 한다. 순서대로 차곡차곡 적어 두었기 때문에, 순서대로 차곡차곡 읽어 내어야 한다. 모두가 다 필요한 정보일 경우에는 불편한 점이 없다.

하지만, 파일 중간의 특정 부분만 읽어 내고 싶을 때가 있다. 간단한 방법은 특정한 정보를 얻어 낼 때까지 순서대로 다 읽고 앞부분은 버리는 방법이 있다. 나머지 뒷 부분은 읽지 않아도 된다. 다소 불편하다고 생각된다. 이러한 불편함을 없애기 위해서 고안된것이 direct access모드 이다. 읽고 적을 때의 모드이다. 디폴트는 sequential 모드이다.

아래의 예제에서 access='direct' 일 때는 당연히 form='unformatted'가 된다. 결국, 사람이 읽을 수 없는 파일이 생성된다. 다만, 장점이 있다면, 디스크를 거의 배열처럼 사용할 수 있다는 장점이 있다. 포트란 문법에서 access='sequential'이 디폴트라는 이야기 이다. 즉, 직접 접근이 필요한 경우는 디폴트가 아니다. 음반 디스크에서 음악을 들을 때 순서대로 음악을 듣는 것이 디폴트이다. 1번곡 듣다가 5번곡을 듣는 행위가 direct access모드에서 가능하다는 말씀이다. 필요한 정보를 필요한 위치에다 덮어서 기록하고, 필요한 정보를 특정한 위치에서 직접 접근해서 읽어 낼 수 있다.

순서대로 정보를 기록하기 위해서는 정보의 단위가 가지는 정량화된 길이가 필요하다. 디스크 한 장에 들어가 있는 여러 노래 하나가 차지하는 공간의 크기를 미리 알아야 한다. 각 노래 한곡이 가지는 '길이의 단위'가 필요하다. 그것이 바로 레코드랭쓰, recl이다. recl=8*(배열길이) 라는 형식으로 미리 알려 줄 필요가 있다. rec=i 는 레코드 i 번째 할당 된 공간을 지칭하는 데 사용될 수 있다. 즉, 읽은 때, 적을 때, read(2,rec=i), write(2,rec=i) 처럼.

       implicit none
       integer j,i
       integer narr,mref
       real*8, allocatable ::  xarr(:,:)
       real*8, allocatable ::  yarr(:,:)
       logical lexist

       narr=10
       mref=3
       allocate(xarr(narr,mref))
       allocate(yarr(narr,mref))


       inquire(file='fort.2',exist=lexist)
       if(lexist)then
       open(2,file='fort.2',access='direct',recl=8*narr,form='unformatted')
       do j=1,mref
       read(2,rec=j) yarr(:,j)
       enddo
       close(2)
                 endif

       do j=1,mref
       do i=1,narr
       xarr(i,j)=float(i)**2/float(j)
       enddo
       enddo

       write(6,*) maxval(abs(xarr-yarr))

       open(2,file='fort.2',access='direct',recl=8*narr,form='unformatted')
       do j=1,mref
       write(2,rec=j) xarr(:,j)
       enddo
       close(2)

       deallocate(xarr)
       deallocate(yarr)
       stop
       end

 

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

       순차적 기록/읽기이며  unformatted 형식일 경우, unformatted 형식은 파일싸이즈에서 유리하고 빨리 읽고, 빨리 적을 수 있어 유용하다.

       implicit none
       integer j,i
       integer narr,mref
       real*8, allocatable ::  xarr(:,:)
       real*8, allocatable ::  yarr(:,:)
       logical lexist

       narr=10
       mref=3
       allocate(xarr(narr,mref))
       allocate(yarr(narr,mref))


       inquire(file='fort.12',exist=lexist)
       if(lexist)then
       open(12,file='fort.12',form='unformatted')
       read(12) yarr(:,:)
       close(12)
                 endif

       do j=1,mref
       do i=1,narr
       xarr(i,j)=float(i)**2/float(j)
       enddo
       enddo

       write(6,*) maxval(abs(xarr-yarr))

       open(12,file='fort.12',form='unformatted')
       write(12) xarr(:,:)
       close(12)

       deallocate(xarr)
       deallocate(yarr)
       stop
       end

 

PS.


      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/4552548



-------------------------------------------
integer number ---> string 형식으로 바꾸는 두 가지 타입을 아래에 표시했다.
 output95.txt
 output0095.txt
 output96.txt
 output0096.txt
 output97.txt
 output0097.txt
 output98.txt
 output0098.txt
 output99.txt
 output0099.txt
 output100.txt
 output0100.txt

       character(len=20) function str(k)
       implicit none
       integer, intent(in) :: k

       write (str, *) k
       str = adjustl(str)
       end function str

       subroutine nume_fisier (i,filename)
       implicit none
       integer :: i
       integer :: izeci,irzeci,isute,rest_sute,imii,irestmii
       character(1) :: f1,f2,f3,f4
       character(4) :: filename

       if(i <= 9) then
       f1=char(48+0)
       f2=char(48+0)
       f3=char(48+0)
       f4=char(48+i)
       elseif(i >=10 .and. i<=99) then
       izeci=int(i/10)
       irzeci=mod(i,10)
       f1=char(48+0)
       f2=char(48+0)
       f3=char(48+izeci)
       f4=char(48+irzeci)
       elseif(i>=100 .and. i<=999) then
       isute=int(i/100)
       rest_sute=mod(i,100)
       izeci=int(rest_sute/10)
       irzeci=mod(rest_sute,10)
       f1=char(48+0)
       f2=char(48+isute)
       f3=char(48+izeci)
       f4=char(48+irzeci)
       elseif(i>= 1000.and. i<=9999) then
       imii=int(i/1000)
       irestmii=mod(i,1000)
       isute=int(irestmii/100)
       rest_sute=mod(irestmii,100)
       izeci=int(rest_sute/10)
       irzeci=mod(rest_sute,10)
       f1=char(48+imii)
       f2=char(48+isute)
       f3=char(48+izeci)
       f4=char(48+irzeci)
       endif
       filename=''//f1//''//f2//''//f3//''//f4//''
       return
       end subroutine nume_fisier

       program num2string
       implicit none
       integer i
       character(len=20) str
       character(4) :: filename

       do i=1,100
       call nume_fisier (i,filename)
       print*, 'output'//trim(str(i))//'.txt'
       print*, 'output'//trim(filename)//'.txt'
!      open(11, file='output'//trim(str(i))//'.txt')
!      write (11, *) i
!      close (11)
       end do
       end program num2string

string2number :
http://incredible.egloos.com/4832216
http://incredible.egloos.com/4836430

program foo

character(len=1024) :: filename
character(len=1024) :: format_string
integer :: i

do i=1, 10
if (i < 10) then
format_string = "(A5,I1)"
else
format_string = "(A5,I2)"
endif

write (filename,format_string) "hello", i
print *, trim(filename)
enddo

end program


------------------------------------------------------
character(len=8) :: fmt ! format descriptor

fmt = '(I5.5)' ! an integer of width 5 with zeros at the left

i1= 59

write (x1,fmt) i1 ! converting integer to string using a 'internal file'

filename='output'//trim(x1)//'.dat'

! ====> filename: output00059.dat


------------------------------------------------
subroutine nume_fisier (i,filename_tot)

   implicit none
   integer :: i

   integer :: integer_zeci,rest_zeci,integer_sute,rest_sute,integer_mii,rest_mii
   character(1) :: filename1,filename2,filename3,filename4
   character(4) :: filename_tot

! Subrutina ce transforma un INTEGER de la 0 la 9999 in o serie de CARACTERE cu acelasi numar

! pentru a fi folosite in numerotarea si denumirea fisierelor de rezultate.

if(i<=9) then

  filename1=char(48+0)
  filename2=char(48+0)
  filename3=char(48+0)
  filename4=char(48+i) 

elseif(i>=10.and.i<=99) then

  integer_zeci=int(i/10)
  rest_zeci=mod(i,10)
  filename1=char(48+0)
  filename2=char(48+0)
  filename3=char(48+integer_zeci)
  filename4=char(48+rest_zeci)

elseif(i>=100.and.i<=999) then

  integer_sute=int(i/100)
  rest_sute=mod(i,100)
  integer_zeci=int(rest_sute/10)
  rest_zeci=mod(rest_sute,10)
  filename1=char(48+0)
  filename2=char(48+integer_sute)
  filename3=char(48+integer_zeci)
  filename4=char(48+rest_zeci)

elseif(i>=1000.and.i<=9999) then

  integer_mii=int(i/1000)
  rest_mii=mod(i,1000)
  integer_sute=int(rest_mii/100)
  rest_sute=mod(rest_mii,100)
  integer_zeci=int(rest_sute/10)
  rest_zeci=mod(rest_sute,10)
  filename1=char(48+integer_mii)
  filename2=char(48+integer_sute)
  filename3=char(48+integer_zeci)
  filename4=char(48+rest_zeci)

endif

filename_tot=''//filename1//''//filename2//''//filename3//''//filename4//''
return
end subroutine nume_fisier

------------------------------------------------
http://stackoverflow.com/questions/1262695/converting-integers-to-strings-in-fortran


-------------------------------------------------
       character(len=20) function str(k)
!      "Convert an integer to string."
       integer, intent(in) :: k
       write (str, *) k
       str = adjustl(str)
       end function str
!     And here is a test code:
       program x
       integer :: i
       character(len=20) :: str

       do i=1,100
           open(11, file='Output'//trim(str(i))//'.txt')
           write (11, *) i
           close (11)
       end do
       end program x

-------------------------------------------------
!234567890
!      character(len=10) :: str = '1.23e1'
!      character(len=10) :: str = ' 1.23e1'
       character(len=10) :: str = ' 1.23e1 '
       real    :: a

!      str=adjustl(str)
       read(str,*) a
       print*, a
       stop
       end

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

!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

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

포트란 기반 데이터 추출 (parsing)


핑백

덧글

  • 아딩 2013/08/06 11:36 # 삭제 답글

    잘 읽었습니다 좋은 참고가 되었습니다
    한가지 궁금한게 recl에서 8*배열길이로 주는 이유가 있나요? 제가 배울 땐 8 대신 4로 썼거든요
  • 바죠 2013/08/06 13:30 #

    double precision, real*8일 경우는 8입니다.
    single precision, real 일 경우에는 4입니다.
    8을 사용하면 4보가 크게 잡게 되니깐 아무 문제가 없겠죠.
댓글 입력 영역

최근 포토로그



MathJax