PP#10～Fortran Tips#5
サブルーチンstrtoimdの作成編の最終回です。これで文字列呼び込みルーチンReadDblArrayが完成します。
前回は読み込んだ文字列の文字数をカウントしましたが、今回は読み込んだ文字数を数値に変換する処理を行います。
繰り返しますが、文字”*”の前段の数値は後段の実数を読み込む回数の事です。念のため。
subroutine strtoimd(Line, Nx, Words, NumValue, IntValue, DblValue)
!********************************************************************************
!* *
!* Convert the String to Integer and Double *
!* *
!********************************************************************************
implicit none
integer,intent(in):: Nx
integer,intent(out):: NumValue, IntValue(Nx)
real*8,intent(out):: DblValue(Nx)
character,intent(inout)::Line*(*)
integer:: NumWord,NumChar(Nx),length, cbegin, cend, count, star, &
endPtr, i, j, k
character:: Words(Nx)*(*)
logical:: digit
!================================================================================
! Function : Convert string to float including the expression like
! : "15*100.0", which is read as double (100.0) by int (15)
! Line : Each line in the input data
! NumWord : Number of words in the Line
! NumChar : Number of characters in each word
! Words : Array of the words comprised of the line
! NumValue : Number of values extracted from the Line
! IntValue : Integer value extracted from the Line
! DblValue : Double value extracted from the Line
! endPtr : Pointer of the remaining word after converting the word
! length : Length of Line
! cbegin : Location of the first character of each word
! cend : Location of the last character of each word
! count : Number of count
!================================================================================
!Extract words from Line given
!================================================================================
length = len_trim(Line) !Calculate length of the string without space
!Global loop to find the "void" character
cbegin = 1
cend = 1
count = 0
do while (cbegin <=length)
if ( Line(cbegin:cbegin) == '0' .or. Line(cbegin:cbegin) == '1' .or. &
Line(cbegin:cbegin) == '2' .or. Line(cbegin:cbegin) == '3' .or. &
Line(cbegin:cbegin) == '4' .or. Line(cbegin:cbegin) == '5' .or. &
Line(cbegin:cbegin) == '6' .or. Line(cbegin:cbegin) == '7' .or. &
Line(cbegin:cbegin) == '8' .or. Line(cbegin:cbegin) == '9' .or. &
Line(cbegin:cbegin) == '-' .or. Line(cbegin:cbegin) == '.' ) then
count = count + 1
do j=cbegin+1,length+1 !Local loop to find the next "void" character
if (Line(j:j) == ' ' .or. Line(j:j) == '\0' .or. Line(j:j) == '\n') then
cend = j - 1
exit
endif
cend = j
enddo
NumChar(count) = cend - cbegin + 1
do k=1,NumChar(count)
Words(count)(k:k) = Line(cbegin+k-1:cbegin+k-1)
enddo
cbegin = cend
endif
cbegin = cbegin + 1
enddo
NumWord = count
!print *, "Numword= ",NumWord, ", Word= ",Words(NumWord)
!================================================================================
!Convert words to digit
!================================================================================
count = 0 !Count number of values
do i=1,NumWord
digit = .true.
do j=1,NumChar(i)
!Check if Words is digit or letter
if (.not.( Words(i)(j:j) == '0' .or. Words(i)(j:j) == '1' .or. &
Words(i)(j:j) == '2' .or. Words(i)(j:j) == '3' .or. &
Words(i)(j:j) == '4' .or. Words(i)(j:j) == '5' .or. &
Words(i)(j:j) == '6' .or. Words(i)(j:j) == '7' .or. &
Words(i)(j:j) == '8' .or. Words(i)(j:j) == '9' .or. &
Words(i)(j:j) == '-' .or. Words(i)(j:j) == '.' .or. &
Words(i)(j:j) == '*' ) ) digit = .false.
enddo
!Convert the string to float
if (digit) then !Words contains digit only
!Check if string contains '*' and location number
star = index( Words(i)(1:NumChar(i)), '*' )
!Convert the string to int and double
if (star > 0) then
count = count + 1
IntValue(count) = atoi( Words(i)(:star-1))
DblValue(count) = atof( Words(i)(star+1:NumChar(i)))
else
count = count + 1
IntValue(count) = 1
DblValue(count) = atof( Words(i)(1:NumChar(i)))
endif
endif
NumValue = count
!print *,"Words = ",Words(i),", NumValue = ",NumValue,", IntValue = ",IntValue(i),", DblValue = ",DblValue(i),", ChrValue = ",ChrValue(i)
enddo
!================================================================================
end subroutine
呼び出すルーチンを含めて、これまで作成した一連の関係サブルーチンを下記に纏めておきます。
program call_ReadDblArray
!********************************************************************************
!* call_ReadDblArray *
!********************************************************************************
implicit none
integer,parameter:: fin = 5
integer,parameter:: Nx = 10, LINEMAX = 130
character(len=LINEMAX)::inkey
integer:: Inx, ip
real*8:: DblArray(Nx)
!================================================================================
do
call getline(fin, inkey)
print '("Key to be input (/ to exit): ", a)', inkey
if (inkey == '/') exit
Inx = 0; call ReadDblArray(inkey, LINEMAX, Inx, Nx, DblArray)
print '("Value to be output:")'
do ip=1,Inx
print '("DblArray (",i2,") = ",f20.7)', ip, DblArray(ip)
enddo
enddo
print '("Reached end of program")'
!================================================================================
stop
!================================================================================
contains
!================================================================================
integer function atoi(String)
!************************************************************************
!* Convert String to Interger Value *
!************************************************************************
implicit none
character,intent(in):: String*(*)
integer:: count, digit
!========================================================================
!read(String,'(i10)') atoi
!========================================================================
count = 1
atoi = 0
do while (count<=len(trim(String)))
if (String(count:count) >= '0' .and. String(count:count) <= '9') then
read(String(count:count),*) digit
atoi = 10*atoi + digit
endif
count = count + 1
enddo
!print '("atoi ", i10)', atoi
!========================================================================
end function
real*8 function atof(String)
!************************************************************************
!* Convert String to Double Precision Value *
!************************************************************************
implicit none
character,intent(in):: String*(*)
!========================================================================
read(String,*) atof
!========================================================================
end function
subroutine getline(File, Line)
!********************************************************************************
!* Read Data in a Line *
!********************************************************************************
implicit none
integer,intent(in):: File
character,intent(inout)::Line*(*)
!================================================================================
read(File, '(a)') Line
!================================================================================
end subroutine
subroutine ReadDblArray(Line, LineMax, Inx, Nx, DblArray)
!********************************************************************************
!* Read the Double Array *
!********************************************************************************
implicit none
integer,intent(in):: Nx, LineMax
integer,intent(inout):: Inx
real*8,intent(out):: DblArray(Nx)
character,intent(inout)::Line*(*)
integer:: NumWord, NumValue, IntValue(Nx), i, j
real*8:: DblValue(Nx)
character:: Words(Nx)*LineMax
!================================================================================
! Line : Line string given
! LineMax : Max characters in Line
! Inx : Index of the DblArray
! Nx : Number of array of the words comprised of the line
! DblArray : Array to be inputed
! NumWord : Number of words in the Line
! Words : Array of the words comprised of the line
! NumValue : Number of values
! IntValue(Nx): Integer value extracted from the Line
! DblValue(Nx): Double value extracted from the Line
!================================================================================
! Extract IntValue and DblValue from the line string given
!================================================================================
call strtoimd(Line, Nx, Words, NumValue, IntValue, DblValue)
!================================================================================
! Input DbleArray given
!================================================================================
do i=1,NumValue
do j=1,IntValue(i)
Inx = Inx + 1
DblArray(Inx) = DblValue(i)
enddo
enddo
!================================================================================
end subroutine
subroutine strtoimd(Line, Nx, Words, NumValue, IntValue, DblValue)
!********************************************************************************
!* *
!* Convert the String to Integer and Double *
!* *
!********************************************************************************
.................
!================================================================================
end subroutine
end program
事例として二つの文字列を入力させた結果はこんな感じ。
如何でしたか？
因みに、strtoimdとはString To Integer and Doubleを示します。うろ覚えですが。
以上