!== Formatted output conversion
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: dcstringprintf.f90,v 1.3 2005/12/22 03:17:20 morikawa Exp $
! Tag Name::  $Name: gt4f90io-20060627 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
!== Overview
!
! C の sprintf(3) のように文字列をフォーマットして返します。
! ただし、実装は C の sprintf(3) とは大分違うのでご注意ください。
!


subroutine DCStringPrintf(unit, fmt, i, r, d, L, s, n, c1, c2, c3, ca) !:nodoc:,2
  !
  ! フォーマット文字列 fmt に従って文字列を返します。 第1引数 fmt
  ! は「<tt>"</tt>」で囲まれ、
  ! その中に出力したい文字列と引数に対応する指示子を書きます。
  ! 指示子には「<tt>%</tt>」を用います。
  ! <tt>%</tt> を用いたい場合は 「<tt>%%</tt>」と記述します。
  ! 指示子に関しての詳細は dcstringprintf.f90 を参照ください。
  !
  use dc_types, only: DP
  use dcstring_base, only: VSTRING, assignment(=), operator(.cat.) !:nodoc:
  implicit none
  type(VSTRING), 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:: cur, endp, ptr, repeat, m
  character(80):: cbuf
continue
  ni = 0;  nr = 0;  nd = 0;  nl = 0;  ns = 0;  nc = 0; na = 0; nn = 0
  unit = ""
  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
      unit = unit .cat. fmt(cur:endp-1)
    else if (endp == cur - 1) then
      unit = unit .cat. fmt(cur: )
      exit
    endif
    !
    ! % から書式指定文字までを fmt(cur:endp) とする
    !
    cur = endp + 1
    endp = cur - 1 + scan(fmt(cur: ), 'DdOoXxFfRrBbYySsCcAa%')
    if (endp < cur) then
      unit = unit .cat. fmt(cur-1: )
      exit
    endif
    cbuf = fmt(cur:endp-1)
    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) unit = unit .cat. ", "
      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)
        unit = unit .cat. trim(adjustl(cbuf))
      case('o', 'O')
        if (.not. present(i)) cycle MainLoop
        ni = ni + 1;  if (ni > size(i)) cycle MainLoop
        write(cbuf, "(o20)") i(ni)
        unit = unit .cat. trim(adjustl(cbuf))
      case('x', 'X')
        if (.not. present(i)) cycle MainLoop
        ni = ni + 1;  if (ni > size(i)) cycle MainLoop
        write(cbuf, "(z20)") i(ni)
        unit = unit .cat. trim(adjustl(cbuf))
      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: ) = " "
        unit = unit .cat. trim(cbuf)
      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: ) = " "
        unit = unit .cat. trim(cbuf)
      case('b', 'B')
        if (.not. present(L)) cycle MainLoop
        nl = nl + 1;  if (nl > size(L)) cycle MainLoop
        write(cbuf, "(L1)") L(nl)
        unit = unit .cat. trim(adjustl(cbuf))
      case('y', 'Y')
        if (.not. present(L)) cycle MainLoop
        nl = nl + 1;  if (nl > size(L)) cycle MainLoop
        if (L(nl)) then
          unit = unit .cat. "yes"
        else
          unit = unit .cat. "no"
        endif
      case('s', 'S')
        if (.not. present(s)) cycle MainLoop
        ns = ns + 1;  if (ns > size(s)) cycle MainLoop
        unit = unit .cat. s(ns)
      case('c', 'C')
        nc = nc + 1
        if (nc == 1) then
          if (present(c1)) unit = unit .cat. c1
        else if (nc == 2) then
          if (present(c2)) unit = unit .cat. c2
        else if (nc == 3) then
          if (present(c3)) unit = unit .cat. c3
        endif
      case('a', 'A')
        if (.not. present(ca)) cycle MainLoop
        na = na + 1;  if (na > size(ca)) cycle MainLoop
        unit = unit .cat. trim(adjustl(ca(na)))
      case('%')
        unit = unit .cat. '%'
      end select
    enddo PercentRepeat
  enddo MainLoop
end subroutine