I have this simple example to test derived-type I/O: I’m playing with the edit descriptors to see what is allowed (on gfortran-12)
module test_dtio
implicit none
type, public :: t
character(10) :: c
contains
procedure, private :: t_write_formatted
generic :: write(formatted) => t_write_formatted
end type t
contains
! print "iotype" for debugging
subroutine t_write_formatted(dtv,unit,iotype,v_list,iostat,iomsg)
class(t), intent(in) :: dtv
integer, intent(in) :: unit
character(len=*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
character(len=80) :: buffer
write(unit,'(A)',iostat=iostat,iomsg=iomsg) iotype
end subroutine t_write_formatted
end module test_dtio
program test
use test_dtio
implicit none
type(t) :: x
x = t('12345')
write(*,*) 'X=',x
write(*,"(a,a)")'X=',x
write(*,"(a,dt)")'X=',x
end program
The example returns:
X= LISTDIRECTED
X=
X=DT
So, it looks like the formatted write routine is not even called when using a non-derived-type specific edit descriptor? Is there any way I could redirect standard labels (A, I, Fw.d, …) in DTIO? The idea is that the derived type could be printed “as a string”, “as an integer”, etc.
With DT option, the defined IO makes use of vlist received argument and parses the string in the format statement of the caller. You can look in the standard document (e.g., 18-007r1) for a write example.
Thank you for the example - yes, it seems like namelist, dt and listdirected (*) options are the only available ones.
Now let me better explain what I had in mind. E.g. let’s have a derived type for an engineering value with units:
type :: pressure
real(real64), private :: p_Pa ! pressure value [Pa]
end type
Now, DT gives me the option to write output formats with several units:
type(pressure) :: p = pressure(101325.d0)
write(*,"(dt'bar')") p ! 1.01325
write(*,"(dt'atm')") p ! 1.00000, etc
However, I cannot use standard edit descriptors anymore, e.g. for the real number format, unless I wrap them into the dt descriptor again. In other words, if p is a real number, I can just run
real(real64) :: p = 101325.d0
write(*,"(f9.2)") p
but there is apparaently no way to define that for a derived type, as I would like to do the same like
type(pressure) :: p = pressure(101325.d0)
write(*,"(f9.2)") p ! should print 101325.00
No, there isn’t the option with 'F' or 'G edit descriptors which makes sense because these format descriptors go with intrinsic types whereas a derived type is not such a type. Thus the standard went with DT.
What the standard allow is list-directed as in
type(pressure) :: p = pressure(101325.d0)
write(*,*) p ! output will be as instructed in the defined IO method for write(formatted)
No, there isn’t the option with F or G edit descriptors which makes sense because these format descriptors go with intrinsic types whereas a derived type is not such a type. Thus the standard went with DT.
What the standard allows is list-directed IO as in
type(pressure) :: p = pressure(101325.d0)
write(*,*) p ! output will be as instructed in the defined IO method for write(formatted)
As you are using gfortran, be aware that there are bugs making DT IO useless in conjunction with recursion and openmp. Even if you do not use this feature within a recursively called procedure or with openmp, just adding generic IO to a type and using/passing an object of such a type can crash a program compiled with gfortran.
You’re right, for example I’ve found that derived type variables with attached DTIO cannot be used as static elements, see this bug that I’ve recently reported. I hope to learn how to contribute patches soon, so far I’m stuck trying to compile gcc with clang on my M1 Mac, maybe I should get a unix machine instead.
It’s my feeling that DTIO would be far more useful if the standard edit descriptors are also allowed for derived types (which could either implement them or not), so I’ve submitted this proposal to the fortran-lang feature proposals page:
I must admit I am totally confused (annoyed) by “derived type IO”
My simple approach is to forget about all the complexity of derived type IO definition (which some compilers do not adequately support) and simply write out the components explicitly. This provides full access to the relevant edit descriptors
My simplified example of your test could be:
module test_dtio
USE ISO_FORTRAN_ENV
implicit none
type, public :: t
character(10) :: c
end type t
type :: pressure
real(real64) :: p_Pa ! pressure value [Pa]
real(real64) :: height ! pressure height [metres]
end type
end module test_dtio
program test
use test_dtio
implicit none
type(t) :: x
type(pressure):: p = pressure(101325.d0, 10.d0)
x = t('12345')
write (*,*) 'X=',x
write (*,*) 'X=', x%c
write (*,*) p ! 1.01325
write (*,fmt='(a,f0.4,2x,f0.4)') 'Pres=',p%p_Pa,p%height
end program
I like the idea of DTIO because it’s a do-it-once-use-it-forever kind of approach (also for binary I/O), but the way it has been thought of lakcs the ‘do-it-once’ part: the DT specifier is nothing else but a more flexible placeholder for A, Fw.d, etc., so why not allow the latter ones directly?
If I’m replacing some variables in a code with a derived type, I also need to change all formatted I/O flags wherever they’re being used. This I think could be solved with a very simple extension to the standard.