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

subroutine DCStringPrintf(unit, fmt, i, r, d, L, s, n, c1, c2, c3)
    use dcstring_base, only: VSTRING, assignment(=), operator(.cat.)
    implicit none
    type(VSTRING), 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:: cur, endp, ptr, repeat, m
    character(80):: cbuf
continue
    ni = 0;  nr = 0;  nd = 0;  nl = 0;  ns = 0;  nc = 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: ), 'DdOoXxFfRrBbYySsCc%')
        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('%')
                unit = unit .cat. '%'
            end select
        enddo PercentRepeat
    enddo MainLoop
end subroutine
