Why are parens required around format strings?

Language enhancement
50

If it is that you can place the format write with the value, creating a little function like the following FMT procedure . can let you do that, and is also handy for converting any numeric value to a string. I have related functions and overloads of the plus and concatenation operators that perhaps get closer but the fmt function is pretty handy. For someone not familiar with the Fortran formatting descriptor “language” like repeat counts and : and so on (which make it particularly nice for printing arrays) something like FMT() is easier to understand as well. It is something handy to use now with Fortran as-is but it would be nice for Fortran to have something like that built-in. Note the format string does not need surrounding parens, which gets back to the more specific OP (Original Post)

program main
implicit none

integer                      :: i
real                         :: a
character(len=:),allocatable :: text

character(len=4096) :: line
character(len=*),parameter   :: asis='(*(g0))'

   i=1
   a=1.123456789
   text="this"

  !py!print(f"{i} is an integer, {a:1.2f} is a rounded real and '{text}' is text")

   print asis,i," is an integer, ",fmt(a,'f0.2')," is a rounded real and '",text,"' is text"

  ! put it into a string with internal write
   write(line,asis)i," is an integer, ",fmt(a,'f0.2')," is a rounded real and '",text,"' is text"
   call doop(trim(line)) ! do something with line

  ! concatenation works too and can be passed as an argument, so more compact in some cases
   line=fmt(i)//" is an integer, "//fmt(a,'f0.2')//" is a rounded real and '"//text//"' is text"
   print asis,trim(line)

contains

subroutine doop(string) ! do some operation on string
character(len=*),intent(in) :: string
integer :: i
   write(*,asis)(string(i:i),i=len(string),1,-1)
end subroutine doop

recursive function fmt(generic,format) result (line)
use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64, real32, real64, real128

! ident_4="@(#) M_framework__msg fmt(3f) convert any intrinsic to a string using specified format"

class(*),intent(in)          :: generic
character(len=*),intent(in),optional  :: format
character(len=:),allocatable :: line
character(len=:),allocatable :: fmt_local
integer                      :: ios
character(len=255)           :: msg
character(len=1),parameter   :: null=char(0)
integer                      :: ilen
   if(present(format))then
      fmt_local=format
   else
      fmt_local=''
   endif
   ! add ",a" and print null and use position of null to find length of output
   ! add cannot use SIZE= or POS= or ADVANCE='NO' on WRITE() on INTERNAL READ,
   ! and do not want to trim as trailing spaces can be significant
   if(fmt_local == '')then
      select type(generic)
         type is (integer(kind=int8));     fmt_local='(i0,a)'
         type is (integer(kind=int16));    fmt_local='(i0,a)'
         type is (integer(kind=int32));    fmt_local='(i0,a)'
         type is (integer(kind=int64));    fmt_local='(i0,a)'
         type is (real(kind=real32));      fmt_local='(1pg0,a)'
         type is (real(kind=real64));      fmt_local='(1pg0,a)'
         type is (real(kind=real128));     fmt_local='(1pg0,a)'
         type is (logical);                fmt_local='(l1,a)'
         type is (character(len=*));       fmt_local='(a,a)'
         type is (complex);                fmt_local='("(",1pg0,",",1pg0,")",a)'
      end select
   else
      if(format(1:1) == '(')then
         fmt_local=format(:len_trim(format)-1)//',a)'
      else
         fmt_local='('//fmt_local//',a)'
      endif
   endif
   allocate(character(len=256) :: line) ! cannot currently write into allocatable variable
   ios=0
   select type(generic)
      type is (integer(kind=int8));     write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (integer(kind=int16));    write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (integer(kind=int32));    write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (integer(kind=int64));    write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (real(kind=real32));      write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (real(kind=real64));      write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (real(kind=real128));     write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (logical);                write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (character(len=*));       write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
      type is (complex);                write(line,fmt_local,iostat=ios,iomsg=msg) generic,null
   end select
   if(ios /= 0)then
      line='<ERROR>'//trim(msg)
   else
      ilen=index(line,null,back=.true.)
      if(ilen == 0)ilen=len(line)
      line=line(:ilen-1)
   endif
end function fmt

end program main

$ fpm run std

fpm: Entering directory '/cygdrive/c/users/jost/github/fun/prints'
Project is up to date

1 is an integer, 1.12 is a rounded real and 'this' is text
txet si 'siht' dna laer dednuor a si 21.1 ,regetni na si 1
1 is an integer, 1.12 is a rounded real and 'this' is text

fpm: Leaving directory '/cygdrive/c/users/jost/github/fun/prints'
2 Likes