| Path: | dcstringsprintf.f90 |
| Last Update: | Tue Jul 18 00:46:47 JST 2006 |
| Authors: | Yasuhiro MORIKAWA, Eizi TOYODA |
| Version: | $Id: dcstringsprintf.f90,v 1.5 2006/07/17 15:46:47 morikawa Exp $ |
| Tag Name: | $Name: gt4f90io-20060827 $ |
| 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 進数) を 20 桁 で表示 |
| %o, %O : | i(:) :: 8 進数データを 20 桁で表示 |
| %x, %X : | i(:) :: 16 進数データを 20 桁で表示 |
| %f, %F : | d(:) :: 倍精度実数データを全桁数 80、小数部の桁数 40で表示 |
| %r, %R : | r(:) :: 単精度実数データを全桁数 80、小数部の桁数 40で表示 |
| %b, %B : | L(:) :: 論理データを 真：T、偽：F で表示 |
| %y, %Y : | L(:) :: 論理データを 真：yes、偽：no で表示 |
| %s, %S : | s(:) :: VSTRINGデータ |
| %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=%d I1=%*d I2=%*d 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=%d I1=%*d I2=%*d 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=%d I1=%*d I2=%*d 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 |
| s(:) : | type(VSTRING), 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, s, n, c1, c2, c3, ca)
!
! フォーマット文字列 fmt に従って変換された文字列を unit に返します。
! 第2引数 fmt には指示子を含む文字列を与えます。
! 指示子には「<tt>%</tt>」を用います。
! <tt>%</tt> を用いたい場合は 「<tt>%%</tt>」と記述します。
! 指示子および用例に関しての詳細は dcstringsprintf.f90 を参照ください。
!
use dcstring_base, only: VSTRING, assignment(=) !:nodoc:
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(:)
type(VSTRING), intent(in), optional:: s(:)
character(*), intent(in), optional:: c1, c2, c3
character(*), intent(in), optional:: ca(:)
! 上記配列引数のカウンタ
integer:: ni, nr, nd, nl, ns, nc, na, nn
integer:: ucur ! unit に書かれた文字数
integer:: endp ! 既に処理された fmt の文字数
integer:: cur ! 現在着目中の文字は fmt(cur:cur) である
integer:: ptr ! fmt から検索をするときに使用
integer:: repeat ! %数字 または %* から決定された繰返し数
integer:: m ! 1:repeat の範囲で動くループ変数
integer:: stat ! エラー処理
character(80):: cbuf ! read/write 文のバッファ
continue
ni = 0
nr = 0
nd = 0
nl = 0
ns = 0
nc = 0
na = 0
nn = 0
unit = ""
ucur = 0
endp = 0
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
else if (cbuf == '') then
repeat = 1
else
ptr = verify(cbuf, " 0123456789")
if (ptr > 0) cbuf(ptr: ) = " "
read(cbuf, "(I80)", iostat=ptr) repeat
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(cbuf, "(i20)") i(ni)
call append(unit, ucur, trim(adjustl(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)
ptr = verify(cbuf, " 0", back=.TRUE.)
if (ptr > 0) cbuf(ptr+1: ) = " "
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)
ptr = verify(cbuf, " 0", back=.TRUE.)
if (ptr > 0) cbuf(ptr+1: ) = " "
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('s', 'S')
if (.not. present(S)) cycle MainLoop
ns = ns + 1
if (ns > size(S)) cycle MainLoop
call append(unit, ucur, s(ns)%body(1: s(ns)%len), stat)
if (stat /= 0) exit MainLoop
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