Allowing an INTEGER array as a LUN on WRITE() statements

[urbanjost]

I have seen code many times with conditional execution of WRITE statements and loops repeatedly executing a WRITE statement using multiple LUNs to provide logging, verbose modes, and debug modes. Aside from the possibility of side-effects from functions called on the WRITE statements (which current methods have an issue with as well) I was wondering what thoughts there might be on allowing the LUN to be an INTEGER array, including of zero length (in which case I would prefer it be a no-op for efficiency). To illustrate the concept I put together a little sample program.

program testit
! Possible use cases, hopefully intuitively obvious would be such as :
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
logical :: verbose_on=.true.
integer,allocatable :: luns(:)
integer :: log
   ! assuming verbose_on and luns() are set in a module or global area and there are many WRITE
   ! statements thoughout the program
   if(verbose_on)then
      luns=[stdout]
   else
      luns=[integer ::]
   endif
   write(luns,*)'verbose or debug message (one of many throughout the program)'

   ! when you want to duplicate output in multiple files
   open(newunit=log,file='record.log')
   luns=[log,stdout]
   write(luns,*)'message'

end program testit

[urbanjost]

As a working example of the basic concept, here is procedure called WRT() that simulates a basic list-directed write statement that can take up to ten intrinsic scalar variables and an array as a LUN for anyone interested in experimenting with the concept.

module M_wrt
use, intrinsic :: iso_fortran_env, only : stderr=>error_unit
private
public :: wrt
contains
function str(g0, g1, g2, g3, g4, g5, g6, g7, g8, g9, nospace)
implicit none
class(*),intent(in),optional  :: g0, g1, g2, g3, g4, g5, g6, g7, g8, g9
logical,intent(in),optional   :: nospace
character(len=:), allocatable :: str
character(len=4096)           :: line
integer                       :: istart, increment
   if(present(nospace))then
      increment=merge(1,2,nospace)
   else
      increment=2
   endif
   istart=1
   line=''
   if(present(g0))call print_g(g0)
   if(present(g1))call print_g(g1)
   if(present(g2))call print_g(g2)
   if(present(g3))call print_g(g3)
   if(present(g4))call print_g(g4)
   if(present(g5))call print_g(g5)
   if(present(g6))call print_g(g6)
   if(present(g7))call print_g(g7)
   if(present(g8))call print_g(g8)
   if(present(g9))call print_g(g9)
   str=trim(line)
contains
subroutine print_g(g)
use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64, real32, real64, real128
class(*),intent(in) :: g
   select type(g)
      type is (integer(kind=int8));     write(line(istart:),'(i0)') g
      type is (integer(kind=int16));    write(line(istart:),'(i0)') g
      type is (integer(kind=int32));    write(line(istart:),'(i0)') g
      type is (integer(kind=int64));    write(line(istart:),'(i0)') g
      type is (real(kind=real32));      write(line(istart:),'(1pg0)') g
      type is (real(kind=real64));      write(line(istart:),'(1pg0)') g
      type is (real(kind=real128));     write(line(istart:),'(1pg0)') g  !*! NOTE: nvfortran does not support this type
      type is (logical);                write(line(istart:),'(l1)') g
      type is (character(len=*));       write(line(istart:),'(a)') trim(g)
      type is (complex);                write(line(istart:),'("(",1pg0,",",1pg0,")")') g
   end select
   istart=len_trim(line)+increment
end subroutine print_g
end function str
subroutine wrt(luns,g0, g1, g2, g3, g4, g5, g6, g7, g8, g9,iostat)
implicit none
integer,intent(in)           :: luns(:)
class(*),intent(in),optional :: g0, g1, g2, g3, g4, g5, g6, g7, g8, g9
integer,intent(out),optional :: iostat
integer                      :: i
character(len=256)           :: msg
   do i=1,size(luns)
      write(luns(i),'(a)',iostat=iostat,iomsg=msg)str(g0,g1,g2,g3,g4,g5,g6,g7,g8,g9)
      if(iostat.ne.0)then
         write(stderr,'(*(g0))')'<ERROR>*write*:',trim(msg)
      endif
   enddo
end subroutine wrt
end module M_wrt

A simple use of the WRT() procedure demonstrates it can take arbitrary scalars and write to no files or multiple files depending on the size and contents of the LUN array.

program demo_wrt
use, intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
use M_wrt, only: wrt
implicit none
integer,allocatable :: luns(:)
integer :: iostat=0
   luns=[integer ::] ! a null list allows for turning off verbose or debug mode output 
   call wrt(luns,'NULL LIST:',huge(0),'PI=',asin(1.0d0)*2.0d0,iostat=iostat)
   write(*,*)'IOSTAT=',iostat
   luns=[stderr,stdout] ! multiple files can be used to create a log file
   call wrt(luns,'TWO FILES:',huge(0),'PI=',asin(1.0d0)*2.0d0,iostat=iostat)
   write(*,*)'IOSTAT=',iostat
   ! unlike direct use of WRITE a function can be used as a list of LUNS if it returns an INTEGER array.
end program demo_wrt

The wrt() procedure should be able to take up to any nine intrinsic scalars of the types listed:

gfortran demo.f90;./a.out
 IOSTAT=           0
TWO FILES: 2147483647 PI= 3.1415926535897931
TWO FILES: 2147483647 PI= 3.1415926535897931
 IOSTAT=           0
[urbanjs@localhost ~]$ ifort demo.f90;./a.out
 IOSTAT=           0
TWO FILES: 2147483647 PI= 3.141592653589793
TWO FILES: 2147483647 PI= 3.141592653589793
 IOSTAT=           0

Note the default is to place a space between output values. This can be suppressed using "nospace=.true".

[FortranFan]

Should the Fortran committee decide to pursue this - note it'll likely require a lot of effort and convincing and influencing - it will be a long wait (years) before an implementation starts to support the facility.

In the meantime, practitioners who are interested in this can consider a workaround with IMPURE ELEMENTAL and try to work within the stipulations of this option:

module m
contains
   impure elemental subroutine write_dat( lun, dat )
      integer, intent(in)  :: lun
      class(*), intent(in) :: dat
      select type ( dat )
         type is ( integer )
            write( lun, advance="no", fmt="(*(g0,1x))" ) dat
         type is ( character(len=*) )
            write( lun, advance="no", fmt="(*(g0,1x))" ) trim(dat)
      end select
   end subroutine
end module
   use, intrinsic :: iso_fortran_env, only : stdout => output_unit
   use m, only : write_dat
   integer :: luns(2)
   open( newunit=luns(1), file="foo.dat" )
   luns(2) = stdout
   call write_dat( luns, "Hello World!" )
   call write_dat( luns, "The answer is" )
   call write_dat( luns, 42 )
end

C:\Temp>gfortran -Wall -std=f2018 io.f90 -o io.exe

C:\Temp>io.exe Hello World! The answer is 42 C:\Temp>type foo.dat Hello World! The answer is 42

C:\Temp>

[urbanjost]

It had not occurred to me that calling an elemental function with a zero-sized array conditionally executed the function, but it makes sense on reflection. Worked fine when I added calls with the EMPTY array.

module m 
contains 
   impure elemental subroutine write_dat( lun, dat ) 
      integer, intent(in)  :: lun 
      class(*), intent(in) :: dat 
      select type ( dat ) 
         type is ( integer ) 
            write( lun, advance="no", fmt="(*(g0,1x))" ) dat 
         type is ( character(len=*) ) 
            write( lun, advance="no", fmt="(*(g0,1x))" ) trim(dat) 
      end select 
   end subroutine 
end module 
   use, intrinsic :: iso_fortran_env, only : stdout => output_unit 
   use m, only : write_dat 
   integer :: luns(2) 
   integer :: empty(0) 
   open( newunit=luns(1), file="foo.dat" ) 
   luns(2) = stdout 
   call write_dat( luns, "Hello World!" ) 
   call write_dat( luns, "The answer is" ) 
   call write_dat( luns, 42 ) 
   call write_dat( luns, NEW_LINE('A') ) 

   call write_dat( empty, "AGAIN:Hello World!" ) 
   call write_dat( empty, "The answer is" ) 
   call write_dat( empty, 42 ) 
   call write_dat( luns, NEW_LINE('A') ) 
end 

[johnwcowan]

How does one recover from an error? You don't know which succeeded and which failed, and WRITE can't be reliably undone.

[urbanjost]

If iostat is a scalar the first error and corresponding iomsg would be returned, but just as unit could be a vector, so could iostat and iomsg and similar options would be one possibility. In a test implementation where I have a procedure called WRITE that takes an array for the LUN it stops doing the writes on the first error and just the info for the write that failed is returned along with a parameter added to the regular write options with an index to the failed array, but I think optionally returning arrays would be better.