| Path: | dcstringsprintf.f90 |
| Last Update: | Fri Dec 29 19:29:27 JST 2006 |
| Authors: | Yasuhiro MORIKAWA, Eizi TOYODA |
| Version: | $Id: dcstringsprintf.f90,v 1.10 2006/12/29 10:29:27 morikawa Exp $ |
| Tag Name: | $Name: gt4f90io-20070720 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. |
| License: | See COPYRIGHT |
C の sprintf(3) のように文字列をフォーマットして返します。 ただし、実装は C の sprintf(3) とは大分違うのでご注意ください。
dc_string#CPrintf, dc_string#Printf のフォーマット引数に 用いられる指示子は % で始まります。種類は 以下の通りです。
| 指示子 : | 対応する引数 :: データの種類と出力形式 |
| %d, %D : | i(:) :: 整数データ (10 進数) を表示.
%2d や %04d のように'%' の後ろに数字を指定することで
出力する桁数を変更できます.
'%' の直後が 0 の場合は先頭に 0 を, そうでない場合は空白を埋めます.
|
| %o, %O : | i(:) :: 8 進数データを表示 |
| %x, %X : | i(:) :: 16 進数データを表示 |
| %f, %F : | d(:) :: 倍精度実数データを最大全桁数 80、小数部の桁数 40で表示 |
| %r, %R : | r(:) :: 単精度実数データを最大全桁数 80、小数部の桁数 40で表示 |
| %b, %B : | L(:) :: 論理データを 真：T、偽：F で表示 |
| %y, %Y : | L(:) :: 論理データを 真：yes、偽：no で表示 |
| %c, %C : | c1、c2、c3 :: 文字データ (変数) |
| %a, %A : | ca :: 文字データ (配列) |
文字データ (変数) 以外は、1つの型のデータをいくつでも与えることが可能です。 文字データ (変数) は c1、c2、c3 にそれぞれ 1 つづつの文字データしか与えることができません。 ca 引数を用いる場合は dc_string#StoA を併用すると便利です。
また、フォーマット指定子として %* を与えることで、 複数のデータを一度に出力することも可能です。 その場合、いくつのデータを一度に出力するかを n(:) に与える必要があります。
use dc_types, only: STRING
use dc_string, only: CPrintf
character(len = STRING) :: output, color="RED", size="Large"
integer, parameter :: n1 = 2, n2 = 3
integer :: int = 10, arrayI1(n1), arrayI2(n2), i
real :: arrayR(n1)
logical :: eq
do, i = 1, n1
arrayI1(i) = 123 * i ; arrayR(i) = 1.23 * i
enddo
do, i = 1, n2
arrayI2(i) = 345 * i
enddo
eq = (maxval(arrayI1) == minval(arrayI2))
output = CPrintf(fmt="color=%c size=%c int=%03d I1=%*d I2=%*04d R=%*r equal=%y", &
& c1=trim(color), c2=trim(size), i=(/int, arrayI1, arrayI2/), &
& r=(/arrayR/), L=(/eq/), n=(/n1, n2, n1/))
write(*,*) trim(output)
文字データ以外のものは基本的に1次元配列しか引数にとれないため、 多次元配列を出力したい場合には組込み関数である pack 関数を 用いると良いでしょう。以下にその例を記します。
use dc_types, only: STRING
use dc_string, only: CPrintf
character(len = STRING) :: output
integer :: i,j,k
integer, parameter :: n1 = 2, n2 = 3, n3 = 4
real :: array(n1,n2,n3)
do, i = 1, n1
do, j = 1, n2
do, k = 1, n3
array(i,j,k) = i * 0.1 + j * 1.0 + k * 10.0
enddo
enddo
enddo
output = CPrintf('array=<%*r>', &
& r=(/pack(array(:,:,:), .true.)/), n=(/size(array(:,:,:))/))
write(*,*) trim(output)
use dc_types, only: STRING
use dc_string, only: Printf
character(len = STRING) :: output, color="RED", size="Large"
integer, parameter :: n1 = 2, n2 = 3
integer :: int = 10, arrayI1(n1), arrayI2(n2), i
real :: arrayR(n1)
logical :: eq
do, i = 1, n1
arrayI1(i) = 123 * i ; arrayR(i) = 1.23 * i
enddo
do, i = 1, n2
arrayI2(i) = 345 * i
enddo
eq = (maxval(arrayI1) == minval(arrayI2))
! 装置番号 6 (標準出力) に直接出力する場合
call Printf(unit=6, &
& fmt="color=%c size=%c int=%03d I1=%*d I2=%*04d R=%*r equal=%y", &
& c1=trim(color), c2=trim(size), i=(/int, arrayI1, arrayI2/), &
& r=(/arrayR/), L=(/eq/), n=(/n1, n2, n1/))
! 文字列 output に渡す場合
call Printf(unit=output, &
& fmt="color=%c size=%c int=%03d I1=%*d I2=%*04d R=%*r equal=%y", &
& c1=trim(color), c2=trim(size), i=(/int, arrayI1, arrayI2/), &
& r=(/arrayR/), L=(/eq/), n=(/n1, n2, n1/))
write(*,*) trim(output)
| Subroutine : | |
| unit : | character(*), intent(out) |
| fmt : | character(*), intent(in) |
| i(:) : | integer, intent(in), optional |
| r(:) : | real, intent(in), optional |
| d(:) : | real(DP), intent(in), optional |
| L(:) : | logical, intent(in), optional |
| n(:) : | integer, intent(in), optional |
| c1 : | character(*), intent(in), optional |
| c2 : | character(*), intent(in), optional |
| c3 : | character(*), intent(in), optional |
| ca(:) : | character(*), intent(in), optional |
フォーマット文字列 fmt に従って変換された文字列を unit に返します。 第2引数 fmt には指示子を含む文字列を与えます。 指示子には「%」を用います。 % を用いたい場合は 「%%」と記述します。 指示子および用例に関しての詳細は dcstringsprintf.f90 を参照ください。
subroutine DCStringSPrintf(unit, fmt, i, r, d, L, n, c1, c2, c3, ca)
!
! フォーマット文字列 fmt に従って変換された文字列を unit に返します。
! 第2引数 fmt には指示子を含む文字列を与えます。
! 指示子には「<tt>%</tt>」を用います。
! <tt>%</tt> を用いたい場合は 「<tt>%%</tt>」と記述します。
! 指示子および用例に関しての詳細は dcstringsprintf.f90 を参照ください。
!
use dc_types, only: DP
implicit none
character(*), intent(out) :: unit
character(*), intent(in) :: fmt
integer, intent(in), optional:: i(:), n(:)
real, intent(in), optional:: r(:)
real(DP), intent(in), optional:: d(:)
logical, intent(in), optional:: L(:)
character(*), intent(in), optional:: c1, c2, c3
character(*), intent(in), optional:: ca(:)
! 上記配列引数のカウンタ
integer:: ni, nr, nd, nl, nc, na, nn
integer:: ucur ! unit に書かれた文字数
integer:: endp ! 既に処理された fmt の文字数
integer:: cur ! 現在着目中の文字は fmt(cur:cur) である
integer:: ptr ! fmt から検索をするときに使用
integer:: exp_ptr ! fmt から数値の指数部を検索をするときに使用
integer:: minus_ptr ! '-' を検索する時に使用
integer:: repeat ! %数字 または %* から決定された繰返し数
integer:: m ! 1:repeat の範囲で動くループ変数
integer:: stat ! エラー処理
character(80):: cbuf ! read/write 文のバッファ
character(80):: exp_buf ! real/write 文の指数部のバッファ (実数型用)
character(80):: ibuf ! real/write 文のバッファ (整数型用)
integer:: len_ibuf ! ibuf の長さ
integer:: figs_ibuf ! ibuf の有効な桁数
logical:: int_zero_fill ! 先頭を 0 で埋めるかどうかを判定するフラグ (整数型用)
integer:: int_figs ! 整数型を出力する際の桁数 (整数型用)
continue
ni = 0
nr = 0
nd = 0
nl = 0
nc = 0
na = 0
nn = 0
unit = ""
ucur = 0
endp = 0
int_figs = 0
int_zero_fill = .false.
MainLoop: do
cur = endp + 1
if (cur > len(fmt)) exit MainLoop
!
! リテラルに転写できる文字列 fmt(cur:endp-1) を発見処理
!
endp = cur - 1 + scan(fmt(cur: ), '%')
if (endp > cur) then
call append(unit, ucur, fmt(cur:endp-1), stat)
if (stat /= 0) exit MainLoop
else if (endp == cur - 1) then
call append(unit, ucur, fmt(cur: ), stat)
exit MainLoop
endif
!
! % から書式指定文字までを fmt(cur:endp) とする
!
cur = endp + 1
endp = cur - 1 + scan(fmt(cur: ), 'DdOoXxFfRrBbYySsCcAa%')
if (endp < cur) then
call append(unit, ucur, fmt(cur-1: ), stat)
exit MainLoop
endif
cbuf = fmt(cur:endp-1)
!
! %* がある場合、n(:) に渡された数から繰り返し回数を取得
!
if (cbuf(1:1) == '*') then
nn = nn + 1
if (nn > size(n)) then
repeat = 1
else
repeat = n(nn)
endif
ibuf = cbuf(2:)
else
repeat = 1
ibuf = cbuf
! else if (cbuf == '') then
! repeat = 1
! else
! ptr = verify(cbuf, " 0123456789")
! if (ptr > 0) cbuf(ptr: ) = " "
! read(cbuf, "(I80)", iostat=ptr) repeat
endif
!
! %2d や %04d のように '%' の後ろに数字が指定され、
! かつ d (整数型変数の表示) の場合には先頭に空白
! または 0 を埋める.
!
if (scan(ibuf(1:1),'1234567890') > 0) then
if (ibuf(1:1) == '0') then
int_zero_fill = .true.
else
int_zero_fill = .false.
end if
read(unit=ibuf, fmt="(i80)") int_figs
else
int_figs = 0
int_zero_fill = .false.
endif
PercentRepeat: do, m = 1, repeat
if (m > 1) then
call append(unit, ucur, ", ", stat)
if (stat /= 0) exit MainLoop
endif
select case(fmt(endp:endp))
case('d', 'D')
if (.not. present(i)) cycle MainLoop
ni = ni + 1
if (ni > size(i)) cycle MainLoop
write(ibuf, "(i20)") i(ni)
len_ibuf = len(trim(adjustl(ibuf)))
figs_ibuf = verify(ibuf, ' ')
cbuf = ' '
if (int_figs > len_ibuf) then
minus_ptr = scan(ibuf, '-')
if (int_zero_fill) then
if (minus_ptr /= 0) then
len_ibuf = len_ibuf - 1
figs_ibuf = figs_ibuf + 1
cbuf(1:int_figs-len_ibuf) = '-0000000000000000000'
else
cbuf(1:int_figs-len_ibuf) = '00000000000000000000'
end if
end if
cbuf(int_figs-len_ibuf+1:) = ibuf(figs_ibuf:20)
else
cbuf = ibuf(figs_ibuf:20)
end if
call append(unit, ucur, trim(cbuf), stat)
if (stat /= 0) exit MainLoop
case('o', 'O')
if (.not. present(i)) cycle MainLoop
ni = ni + 1
if (ni > size(i)) cycle MainLoop
write(cbuf, "(o20)") i(ni)
call append(unit, ucur, trim(adjustl(cbuf)), stat)
if (stat /= 0) exit MainLoop
case('x', 'X')
if (.not. present(i)) cycle MainLoop
ni = ni + 1
if (ni > size(i)) cycle MainLoop
write(cbuf, "(z20)") i(ni)
call append(unit, ucur, trim(adjustl(cbuf)), stat)
if (stat /= 0) exit MainLoop
case('f', 'F')
if (.not. present(d)) cycle MainLoop
nd = nd + 1
if (nd > size(d)) cycle MainLoop
write(cbuf, "(g80.40)") d(nd)
cbuf = adjustl(cbuf)
exp_ptr = verify(cbuf, ' 1234567890-+.', back=.TRUE.)
exp_buf = ' '
if (exp_ptr > 0) then
exp_buf = cbuf(exp_ptr: )
cbuf(exp_ptr: ) = " "
end if
ptr = verify(cbuf, " 0", back=.TRUE.)
if (ptr > 0) cbuf(ptr+1: ) = " "
cbuf = trim(cbuf) // trim(exp_buf)
call append(unit, ucur, trim(adjustl(cbuf)), stat)
if (stat /= 0) exit MainLoop
case('r', 'R')
if (.not. present(r)) cycle MainLoop
nr = nr + 1
if (nr > size(r)) cycle MainLoop
write(cbuf, "(g80.40)") r(nr)
cbuf = adjustl(cbuf)
exp_ptr = verify(cbuf, ' 1234567890-+.', back=.TRUE.)
exp_buf = ' '
if (exp_ptr > 0) then
exp_buf = cbuf(exp_ptr: )
cbuf(exp_ptr: ) = " "
end if
ptr = verify(cbuf, " 0", back=.TRUE.)
if (ptr > 0) cbuf(ptr+1: ) = " "
cbuf = trim(cbuf) // trim(exp_buf)
call append(unit, ucur, trim(adjustl(cbuf)), stat)
if (stat /= 0) exit MainLoop
case('b', 'B')
if (.not. present(L)) cycle MainLoop
nl = nl + 1
if (nl > size(L)) cycle MainLoop
write(cbuf, "(L1)") L(nl)
call append(unit, ucur, trim(adjustl(cbuf)), stat)
if (stat /= 0) exit MainLoop
case('y', 'Y')
if (.not. present(L)) cycle MainLoop
nl = nl + 1
if (nl > size(L)) cycle MainLoop
if (L(nl)) then
call append(unit, ucur, "yes", stat)
if (stat /= 0) exit MainLoop
else
call append(unit, ucur, "no", stat)
if (stat /= 0) exit MainLoop
endif
case('c', 'C')
nc = nc + 1
if (nc == 1) then
if (.not. present(c1)) cycle PercentRepeat
call append(unit, ucur, c1, stat)
if (stat /= 0) exit MainLoop
else if (nc == 2) then
if (.not. present(c2)) cycle PercentRepeat
call append(unit, ucur, c2, stat)
if (stat /= 0) exit MainLoop
else if (nc == 3) then
if (.not. present(c3)) cycle PercentRepeat
call append(unit, ucur, c3, stat)
if (stat /= 0) exit MainLoop
endif
case('a', 'A')
if (.not. present(ca)) cycle MainLoop
na = na + 1
if (na > size(ca)) cycle MainLoop
call append(unit, ucur, trim(adjustl(ca(na))), stat)
if (stat /= 0) exit MainLoop
case('%')
call append(unit, ucur, '%', stat)
if (stat /= 0) exit MainLoop
end select
enddo PercentRepeat
enddo MainLoop
return
contains
subroutine append(unitx, ucur, val, stat)
!
! unitx に val を付加。その際、unitx がその最大文字列長を越えた場合
! には stat = 2 を返す。
!
character(*), intent(inout):: unitx ! 最終的に返される文字列
integer, intent(inout):: ucur ! unitx の文字数
character(*), intent(in) :: val ! unitx に付加される文字列
integer, intent(out) :: stat ! ステータス
integer :: wrsz ! val の文字列
continue
! unitx の最大長を越えた場合には stat = 2 を返す。
if (ucur >= len(unitx)) then
stat = 2
! 正常時の処理
else
! unitx の長さを越えた場合も考慮して unitx に val を付加する。
wrsz = min(len(val), len(unitx) - ucur)
unitx(1+ucur: wrsz+ucur) = val(1: wrsz)
ucur = ucur + wrsz
stat = 0
if (wrsz < len(val)) stat = 1
endif
end subroutine append
end subroutine DCStringSPrintf