! C の sprintf(3) とは大分違うので注意。
!

subroutine DCStringSPrintf(unit, fmt, i, r, d, L, s, n, c1, c2, c3)
    use dcstring_base, only: VSTRING, assignment(=)
    implicit none
    character(*), intent(out):: unit
    character(*), intent(in):: fmt
    integer, intent(in), optional:: i(:), n(:)
    real, intent(in), optional:: r(:)
    double precision, intent(in), optional:: d(:)
    logical, intent(in), optional:: L(:)
    type(VSTRING), intent(in), optional:: s(:)
    character(*), intent(in), optional:: c1, c2, c3
    ! 上記配列引数のカウンタ
    integer:: ni, nr, nd, nl, ns, nc, 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;  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: ), 'DdOoXxFfRrBbYySsCc%')
        if (endp < cur) then
            call append(unit, ucur, fmt(cur-1: ), stat)
            exit MainLoop
        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) 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('%')
                call append(unit, ucur, '%', stat)
                if (stat /= 0) exit MainLoop
            end select
        enddo PercentRepeat
    enddo MainLoop
    return
contains

    subroutine append(unit, ucur, val, stat)
        character(*), intent(inout):: unit
        integer, intent(inout):: ucur
        character(*), intent(in):: val
        integer, intent(out):: stat
        integer:: wrsz
    continue
        if (ucur >= len(unit)) then
            stat = 2
        else
            wrsz = min(len(val), len(unit) - ucur)
            unit(1+ucur: wrsz+ucur) = val(1: wrsz)
            ucur = ucur + wrsz
            stat = 0
            if (wrsz < len(val)) stat = 1
        endif
    end subroutine

end subroutine
