Hopefully, if you use the IOMSG option on your READ you will get a useful message including the location. If not, it depends on how hard it is to re-read just
the NAMELIST group you want (note that a BACKSPACE of a NAMELIST file is
NOT supported by the standard – if it works it is an extension). Assuming you have just one in a file it is easy to rewind the file and start by reading one line into
an internal file and then adding a last line of “/” and reading from that, increasing
one line at a time till an error occurs.
You would probably read it normally and then only try to slurp the file into an internal file if an error occurs, but for a
simple example (ignoring the procedure that reads the file into memory for simplicity) it might go something like this:
ASCII file slurper
module m_io
implicit none
character(len=*),parameter :: gen= '(*(g0))'
private
public :: fileread
contains
subroutine fileread(filename,pageout)
character(len=*),intent(in) :: filename
character(len=:),allocatable,intent(out) :: pageout(:)
character(len=1),allocatable :: text(:)
call filebyte(filename,text)
if(.not.allocated(text))then
write(*,*)'*fileread* failed to load file '//filename
else
pageout=topage(text)
deallocate(text)
endif
contains
function topage(array) result (table)
character(len=1),intent(in) :: array(:)
character(len=:),allocatable :: table(:)
integer :: i
integer :: linelength
integer :: length
integer :: lines
integer :: linecount
integer :: position
integer :: sz
character(len=1),parameter :: nl = char(10)
character(len=1),parameter :: cr = char(13)
lines = 0
linelength = 0
length = 0
sz=size(array)
do i = 1,sz
if( array(i) == nl )then
linelength = max(linelength,length)
lines = lines + 1
length = 0
else
length = length + 1
endif
enddo
if( sz > 0 )then
if( array(sz) /= nl )then
lines = lines+1
endif
endif
if(allocated(table))deallocate(table)
allocate(character(len=linelength) :: table(lines))
table(:) = ' '
linecount = 1
position = 1
do i = 1,sz
if( array(i) == nl )then
linecount=linecount+1
position=1
elseif( array(i) == cr )then
elseif( linelength /= 0 )then
table(linecount)(position:position) = array(i)
position = position+1
endif
enddo
end function topage
end subroutine fileread
subroutine filebyte(filename,text)
character(len=*),intent(in) :: filename
character(len=1),allocatable,intent(out) :: text(:)
integer :: nchars=0
integer :: igetunit
integer :: ios=0
integer :: i
character(len=256) :: message
character(len=4096) :: label
character(len=:),allocatable :: line
message=''
open(newunit=igetunit, file=trim(filename), action="read", iomsg=message,&
&form="unformatted", access="stream",status='old',iostat=ios)
label=filename
if(ios == 0)then
inquire(unit=igetunit, size=nchars)
if(nchars <= 0)then
write(*,gen) '*filebyte* empty file '//trim(label)
return
endif
if(allocated(text))deallocate(text)
allocate ( text(nchars) )
read(igetunit,iostat=ios,iomsg=message) text
if(ios /= 0)then
write(*,gen)'*filebyte* bad read of '//trim(label)//':'//trim(message)
endif
else
write(*,gen)'*filebyte* '//message
allocate ( text(0) )
endif
close(iostat=ios,unit=igetunit)
end subroutine filebyte
end module m_io
program main
use M_io, only : fileread
implicit none
character(len=*),parameter :: gen= '(*(g0))'
character(len=:),allocatable :: page(:) , test(:)
integer :: param1 ; namelist /config/ param1
real :: param2 ; namelist /config/ param2
character(len=256) :: param3 ; namelist /config/ param3
character(len=256) :: iomsg
integer :: iostat
integer :: i
! allocate character array and copy file into it
call fileread('namelist.nml',page)
if(.not.allocated(page))then
write(*,gen)'<ERROR>*whichline* failed to load file'
stop 1
endif
read(page,nml=config,iostat=iostat,iomsg=iomsg)
if(iostat.ne.0)then
write(*,gen)'<ERROR>*whichline* '//trim(iomsg)
write(*,gen)'<ERROR>*whichline* locating error:'
do i=1,size(page)
test=[character(len=len(page)) :: page(:i),'/']
read(test,nml=config,iostat=iostat,iomsg=iomsg)
if(iostat.ne.0)then
write(*,gen)'<ERROR>*whichline* on line ',i,' : ',trim(page(i))
!write(*,gen)'<ERROR>*whichline* '//trim(iomsg)
stop 2
endif
enddo
endif
deallocate(page) ! release memory
end program main
So given the assumption you can isolate just the namelist with the error in it,
and that the input file is really large and often hand-edited so errors like this
occur in the first place, that might work. We have a program where the code itself does not do that check, but if a user composes or changes an input file they have
to validate it using a program that has the same namelist defined in it similar to the above program before they insert it into a bigger multi-case input file.
How well the compiler IOMSG works is very compiler-specific but that is simple when it works well. If you have that (rare(?)) situation where you are making really big NAMELIST inputs at least partially manually maybe an approach like the pre-tester described above is worth it. The syntax of a NAMELIST input is structured well enough it can also probably be syntax-checked relatively easily reading it in and checking if it following rules byte-by-byte. That will not find type mismatches and unknown or misspelled variable names and so on but would find something like the ===.
Would need more info on exactly why spotting errors by eye along with the IOMSG is not sufficient, and whether you only have one set per file and how much time or impact these kinds of errors are having to say if any of that is worth it or not
Sample output
================================================================================
&config
param1 = 10
param2 === 0.5 ! problematic line
param3 = "Hello"
/
================================================================================
<ERROR>*whichline* namelist read: misplaced = sign
<ERROR>*whichline* locating error:
<ERROR>*whichline* on line 3 : param2 === 0.5 ! problematic line