!== Formatted output conversion ! ! Authors:: Yasuhiro MORIKAWA, Eizi TOYODA ! Version:: $Id: dcstringsprintf.f90,v 1.5 2006/07/17 15:46:47 morikawa Exp $ ! Tag Name:: $Name: gt4f90io-20060719-1 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! !== Overview ! ! C の sprintf(3) のように文字列をフォーマットして返します。 ! ただし、実装は C の sprintf(3) とは大分違うのでご注意ください。 ! !== Formatter ! ! 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(:) ! に与える必要があります。 ! !== Example ! !=== dc_string#CPrintf を用いた出力の例 ! ! 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) ! !=== dc_string#Printf を用いた出力の例 ! ! 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 DCStringSPrintf(unit, fmt, i, r, d, L, s, n, c1, c2, c3, ca) ! ! フォーマット文字列 fmt に従って変換された文字列を unit に返します。 ! 第2引数 fmt には指示子を含む文字列を与えます。 ! 指示子には「%」を用います。 ! % を用いたい場合は 「%%」と記述します。 ! 指示子および用例に関しての詳細は 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