dcstringsprintf.f90

Path: dcstringsprintf.f90
Last Update: Mon Oct 09 19:35:42 JST 2006

Formatted output conversion

Authors:Yasuhiro MORIKAWA, Eizi TOYODA
Version:$Id: dcstringsprintf.f90,v 1.6 2006/10/09 10:35:42 morikawa Exp $
Tag Name:$Name: gt4f90io-20061118 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See 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)

Required files

Methods

Included Modules

dc_types

Public Instance methods

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 を参照ください。

[Source]

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, 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

Private Instance methods

Subroutine :
unitx :character(*), intent(inout)
: 最終的に返される文字列
ucur :integer, intent(inout)
: unitx の文字数
val :character(*), intent(in)
: unitx に付加される文字列
stat :integer, intent(out)
: ステータス

unitx に val を付加。その際、unitx がその最大文字列長を越えた場合 には stat = 2 を返す。

[Source]

  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

[Validate]