! 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