207 lines
7.9 KiB
Fortran
207 lines
7.9 KiB
Fortran
! Commatizing numbers
|
|
!
|
|
! tested with Intel ifx (IFX) 2025.2.1 20250806 on Kubuntu 25.04
|
|
! GNU Fortran (Ubuntu 14.2.0-19ubuntu2) 14.2.0 on Kubuntu 25.04
|
|
! Note that VSI Fortran on VMS does not compile this code because its current version
|
|
! cannot handle allocatable character strings
|
|
!
|
|
! U.B., August 2025
|
|
!
|
|
program commatisator
|
|
|
|
implicit none
|
|
|
|
logical, parameter ::DEBUG=.false.
|
|
|
|
|
|
call commatize("pi=3.14159265358979323846264338327950288419716939937510582097494459231", 3, 5)
|
|
call commatize("The author has two Z$100000000000000 Zimbabwe notes (100 trillion).", 1,3, '.') ! Use decimal point as separator
|
|
call commatize('"-in Aus$+1411.8millions"') ! Here the double quotes (") are part of the text.
|
|
call commatize("===US$0017440 millions=== (in 2000 dollars)")
|
|
call commatize("123.e8000 is pretty big.")
|
|
call commatize("The land area of the earth is 57268900(29% of the surface) square miles.")
|
|
call commatize("Ain't no numbers in this here words, nohow, no way, Jose.")
|
|
call commatize("James was never known as 0000000007", 0,3)
|
|
call commatize("Arthur Eddington wrote: I believe there are " // &
|
|
"15747724136275002577605653961181555468044717914527116709366231425076185631031296" // &
|
|
" protons in the universe.")
|
|
call commatize(" $-140000±100 millions.")
|
|
call commatize("6/9/1946 was a good year for some.")
|
|
|
|
contains
|
|
|
|
subroutine commatize (text, astartIdx, agroupSize, aseparator)
|
|
! Arguments
|
|
character(*), intent(in) :: text
|
|
integer, intent(in), optional :: astartIdx
|
|
integer, intent(in), optional :: agroupSize
|
|
character, intent(in), optional :: aseparator
|
|
|
|
! These variables are there even if optional args are omitted.
|
|
integer :: startIdx
|
|
integer :: groupSize
|
|
character :: separator
|
|
|
|
integer :: sz, ii
|
|
integer :: ipBegin, ipPoint, ipEnd
|
|
|
|
character(:), allocatable :: newtext
|
|
!
|
|
! Defaults for optional arguments
|
|
! and protect against invalid arguments
|
|
if (present (astartIdx)) then
|
|
startIDx = max (1, astartidx)
|
|
else
|
|
startIdx = 1
|
|
endif
|
|
if (present (agroupSize)) then
|
|
groupsize = max(1, agroupsize)
|
|
else
|
|
groupsize = 3
|
|
endif
|
|
if (present (aseparator)) then
|
|
separator = aseparator
|
|
else
|
|
separator = ','
|
|
endif
|
|
|
|
sz = len (text)
|
|
ipBegin = 0
|
|
ipPoint = 0
|
|
ipEnd = 0
|
|
|
|
! Find beginning and end of the first numeric part of the string
|
|
do ii=startidx,sz
|
|
if (isadigit (text(ii:ii), '1','9')) then ! ignoring leading zeroes
|
|
ipBegin = ii
|
|
exit ! Only the very first number is of any interest.
|
|
else if (text(ii:ii) .eq. '.') then ! Leading Decimal point
|
|
if (ii .lt. sz) then
|
|
if (isadigit (text(ii+1:ii+1), '0','9')) then ! must be followed by a valid digit
|
|
! Entire number starts here, it is something valid like ".123"
|
|
if (DEBUG) print *, 'Decimal point detected at ii,sz= ', ii, sz
|
|
ipBegin = ii
|
|
ipPoint = ii
|
|
exit
|
|
endif
|
|
endif
|
|
end if
|
|
end do
|
|
|
|
! Any number detected? Search for the end and, if necessary, the decimal point
|
|
if (ipBegin .gt. 0 .and. ipBegin .le. sz) then
|
|
do ii=ipBegin+1, sz+1
|
|
if (ii > sz) then
|
|
ipEnd = sz
|
|
else if (text(ii:ii) .eq. '.' .and. ipPoint .eq. 0 .and. ii .lt. sz ) then
|
|
if (isadigit (text(ii+1:ii+1), '0','9')) then ! Decimal point must be followed by valid digit
|
|
ipPoint = ii
|
|
else
|
|
ipEnd = ii-1 ! Might be valid decimal point, but terminates the number.
|
|
exit ! no need to continue, have found the end.
|
|
endif
|
|
else if (.not. isadigit (text(ii:ii), '0','9')) then ! Anything other than a digit or point terminated the number.
|
|
ipEnd = ii-1
|
|
exit
|
|
end if
|
|
enddo
|
|
end if
|
|
|
|
! Found a number?
|
|
! Three possibe cases: real number (>=1) with decimal point and digits before and after
|
|
! real number (<1) starting with decimal point such as .71
|
|
! integer number without decimal point.
|
|
if (ipBegin .ne. 0) then ! Any nmumber
|
|
if (ipPoint .gt. ipbegin) then ! Not starting with a decimal point but decimal point inside
|
|
if (ipBegin .gt. 1) then
|
|
newtext = text (:ipBegin-1) ! copy entire text before the numeric
|
|
else
|
|
newtext = '' ! In any case variable 'newtext' must be initialized
|
|
end if
|
|
newtext = newtext // setSeparators (text, ipPoint-1, ipBegin, &
|
|
groupsize, separator , requiredSize (ipPoint-1, ipBegin, groupsize)) // '.'
|
|
newtext = newtext // setSeparators (text, ipPoint+1, ipEnd, &
|
|
groupsize, separator, requiredSize (ipPoint+1, ipEnd ,groupsize))
|
|
else if (ipPoint .ne. 0 .and. ipPoint .lt. sz) then ! Starting with decimal point
|
|
newtext = '.' // setSeparators (text, ipPoint+1, ipEnd, &
|
|
groupsize, separator, requiredSize (ipPoint+1, ipEnd,groupsize) )
|
|
else ! Integer number
|
|
newtext = text (:ipBegin-1) // setSeparators (text, ipEnd, ipBegin, &
|
|
groupsize, separator, requiredSize (ipEnd, ipBegin, groupsize) )
|
|
endif
|
|
if (ipEnd .lt. sz) then
|
|
newtext = newtext // text (ipend+1:) ! Append alltext behind the number
|
|
endif
|
|
else ! No number, just print straight copy
|
|
newtext = text
|
|
endif
|
|
|
|
print '("Before: ", A)' , text
|
|
print '(" After: ", A/)', newtext
|
|
|
|
|
|
end subroutine commatize
|
|
|
|
! estimate how many separators wii be needed in a given range of digits
|
|
! and calculate the new tring length therefrom.
|
|
function requiredSize (i0,i1,step) result (size)
|
|
integer, intent(in) :: i0, i1, step
|
|
integer :: size
|
|
integer :: l,c
|
|
|
|
l = iabs (i1-i0) + 1 ! Length of the string to be considered
|
|
c = (l-1) / step ! Number of separators to insert
|
|
|
|
size = l + c
|
|
end function requiredSize
|
|
|
|
! Insert separators into a numerical string
|
|
function setSeparators (text, i0, i1, step, separator, resSize ) result (ntext )
|
|
character(*), intent(in) :: text ! entire text
|
|
integer, intent(in) :: i0,i1 ! The numeric part goes from i0 to i1 (incl)
|
|
integer, intent(in) :: step ! the group size between separators
|
|
character, intent(in) :: separator ! the separator character
|
|
integer, intent(in) :: resSize ! New size of result string
|
|
character(len=resSize) :: ntext ! The resultant string, including th e separators
|
|
integer :: ii, jj, cnt, direction ! Helpers
|
|
|
|
! character-wise copy the old text into new text
|
|
! Loop index can go into either direction
|
|
if (i0 .gt. i1 ) then
|
|
direction = -1
|
|
else
|
|
direction = 1
|
|
end if
|
|
|
|
! Position of text(ii:ii) inside the resultant text
|
|
if (i0 .lt. i1) then
|
|
jj = 1
|
|
else
|
|
jj = resSize
|
|
end if
|
|
|
|
cnt = 0
|
|
do ii = i0, i1, direction
|
|
ntext (jj:jj) = text (ii:ii) ! Copy characters
|
|
jj = jj + direction
|
|
cnt = cnt + 1 ! count copied characters
|
|
! Group complete? Insert separator
|
|
if (cnt .eq. step .and. jj .gt. 0 .and. jj .lt. resSize) then
|
|
ntext(jj:jj) = separator
|
|
jj = jj + direction
|
|
cnt = 0
|
|
end if
|
|
end do
|
|
end function setSeparators
|
|
|
|
! Decide if a given character c is a digit in the range from "from" to "to".
|
|
function isadigit (c, from, to) result (YN)
|
|
character, intent(in) :: c, from, to
|
|
logical :: YN
|
|
|
|
YN = c>= from .and. c<=to
|
|
end function isadigit
|
|
|
|
|
|
|
|
end program commatisator
|