| unit : | type(VSTRING), intent(out)
|
| fmt : | character(*), intent(in)
|
| i(:) : | integer, intent(in), optional
|
| r(:) : | real, intent(in), optional
|
| d(:) : | double precision, intent(in), optional
|
| L(:) : | logical, intent(in), optional
|
| s(:) : | type(VSTRING), 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
|
subroutine DCStringPrintf(unit, fmt, i, r, d, L, s, n, c1, c2, c3, ca)
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
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