@iarbina , @urbanjost :
If you don’t mind some code toward custom handling of NAMELIST
components of derived type, you could consider defined input/output data transfers that the standard supports since Fortran 2003.
See a working example below if you wish to try (again, hope you don’t mind it’s with a commercial processor whose support staff I have bugged over the years to get this and other standard features working):
Click to see Fortran code
Defined input/output with NAMELIST
module point_m
enum, bind(C)
enumerator :: RED
enumerator :: BLUE
enumerator :: GREEN
end enum
type :: point_t
real :: x = 0.0
real :: y = 0.0
integer :: color = RED
contains
private
procedure, pass(dtv) :: read_point_t
procedure, pass(dtv) :: write_point_t
generic, public :: read(formatted) => read_point_t
generic, public :: write(formatted) => write_point_t
end type
character(len=*), parameter :: QUOTE = "'"
character(len=*), parameter :: BEGIN_TOKEN = "<"
character(len=*), parameter :: END_TOKEN = ">"
contains
subroutine read_point_t(dtv, lun, iotype, vlist, istat, imsg)
! Argument list
class(point_t), intent(inout) :: dtv
integer, intent(in) :: lun
character(len=*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
integer, intent(out) :: istat
character(len=*), intent(inout) :: imsg
! Local variables
real :: x
real :: y
integer :: color
integer :: beg_idx, end_idx
character(len=2048) :: nml_str
namelist / point / x, y, color
select case ( iotype )
case ( "LISTDIRECTED" )
! Elided
case ( "DT" )
! Elided
if ( size(vlist) == 0 ) istat = 1
case ( "NAMELIST" )
read_blk: block
read( unit=lun, fmt=*, iostat=istat, iomsg=imsg ) nml_str
if ( istat /= 0 ) exit read_blk
beg_idx = index( nml_str, BEGIN_TOKEN )
if ( beg_idx == 0 ) then
istat = 1
imsg = "Error parsing namelist string for point_t type"
exit read_blk
end if
end_idx = index( nml_str, END_TOKEN, back=.true. )
if ( end_idx == 0 ) then
istat = 2
imsg = "Error parsing namelist string for point_t type"
exit read_blk
end if
if ( beg_idx + 1 >= end_idx-1 ) then
istat = 3
imsg = "Error parsing namelist string for point_t type"
exit read_blk
end if
read( unit=nml_str(beg_idx+1:end_idx-1), nml=point, iostat=istat, iomsg=imsg )
if ( istat /= 0 ) exit read_blk
dtv%x = x
dtv%y = y
dtv%color = color
end block read_blk
return
case default
end select
return
end subroutine read_point_t
subroutine write_point_t( dtv, lun, iotype, vlist, istat, imsg )
! Argument list
class(point_t), intent(in) :: dtv
integer, intent(in) :: lun
character(len=*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
integer, intent(out) :: istat
character (len=*), intent(inout) :: imsg
! Local variables
real :: x
real :: y
integer :: color
character(len=2048) :: nml_str
namelist / point / x, y, color
istat = 0
select case ( iotype )
case ( "LISTDIRECTED" )
! Elided
case ( "DT" )
! Elided
if ( size(vlist) == 0 ) istat = 1
case ( "NAMELIST" )
x = dtv%x
y = dtv%y
color = dtv%color
write( unit=nml_str, nml=point, iostat=istat, iomsg=imsg )
if ( istat == 0 ) then
write( unit=lun, fmt="(*(g0))", iostat=istat, iomsg=imsg) QUOTE, BEGIN_TOKEN, &
trim(nml_str), END_TOKEN, QUOTE
end if
return
end select
return
end subroutine
end module
use, intrinsic :: iso_fortran_env, only : stdout => output_unit
use point_m
type(point_t) :: point
character(len=:), allocatable :: stream_data
character(len=:), allocatable :: msg
character(len=2048) :: imsg
integer :: istat
namelist / dat / msg, point
stream_data = "&dat msg='Hello World!', point=" // QUOTE // BEGIN_TOKEN // &
"&point x=1.0, y=2.0, color=1 /" // END_TOKEN // QUOTE // "/"
allocate( character(len=132) :: msg )
read( stream_data, nml=dat, iostat=istat, iomsg=imsg )
if ( istat == 0 ) then
print *, "point%x = ", point%x, "; expected is 1.0"
print *, "point%y = ", point%y, "; expected is 2.0"
print *, "point%color = ", point%color, "; expected is 1"
msg = trim(msg)
write( stdout, nml=dat )
else
print *, "Namelist read failed: iostat = ", istat
print *, trim(imsg)
end if
end
C:\temp>ifort /standard-semantics p.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.3.0 Build 20210609_000000
Copyright (C) 1985-2021 Intel Corporation. All rights reserved.
Microsoft (R) Incremental Linker Version 14.29.30038.1
Copyright (C) Microsoft Corporation. All rights reserved.
-out:p.exe
-subsystem:console
p.obj
C:\temp>p.exe
point%x = 1.000000 ; expected is 1.0
point%y = 2.000000 ; expected is 2.0
point%color = 1 ; expected is 1
&DAT
MSG = Hello World!,
POINT= ‘<&POINT X= 1.000000 ,Y= 2.000000 ,COLOR= 1/>’
/
C:\temp>