I want to read variables from the program. The main program is
PROGRAM nltest
IMPLICIT NONE
real :: A
REAL :: B
real :: C, D
namelist /FirstName/ A, B
namelist /SecondName/ C, D
OPEN (UNIT=10, FILE='FirstData.dat', STATUS='UNKNOWN')
READ (10, NML=FirstName)
! CLOSE (10)
! OPEN (UNIT=10, FILE='FirstData.dat', STATUS='UNKNOWN')
READ (10, NML=SecondName)
CLOSE (10)
PRINT 100, A, B
100 FORMAT (' A = ', f8.4, ' B = ', f8.4)
END PROGRAM nltest
gfortran main.f90 -o main
C:\Users\owner\Desktop>main
At line 15 of file main.f90 (unit = 10, file = 'FirstData.dat')
Fortran runtime error: End of file
Error termination. Backtrace:
#0 0x22a1fb85 in next_record_r
at ../../../gcc-14.1.0/libgfortran/io/transfer.c:3899
#1 0x22a2c5a4 in finalize_transfer
at ../../../gcc-14.1.0/libgfortran/io/transfer.c:4452
#2 0x229f17c5 in ???
#3 0x229f18b3 in ???
#4 0x229f139d in ???
#5 0x229f14d5 in ???
#6 0xf55f7373 in ???
#7 0xf6a7cc90 in ???
#8 0xffffffff in ???
So is it not possible to use multiple namelists? Or how to use different namelists from the file?
You are probably missing a line terminator on the last line, and @shahmoradi points to a way to
avoid that error. Since a NAMELIST file skips lines not in a NAMELIST group definition instead of
adding blank lines to the end of the file I prefer a line of printable text such as “END-OF-FILE”.
NAMELIST group input file
Sat Jan 18 2025
&FirstName
A= 0.50 ,
B= 0.02 ,
/
&SecondName
C= 0.40 ,
D= 0.01 ,
/
END-OF-FILE
Adding printable text after the last set of data is recommended as it is less likely to be inadvertently removed. The problem is even if you add IOSTAT= to the READ statements and test for end-of-file you also get end-of-file when the NAMELIST group is not present or is truncated, so testing for an end-of-file status after the read is ambiguous. It is a useful feature of NAMELIST that it allows other text in the file, as it allows easy annotation of your data files so you can track their pedigree.
If you do “wc -c” on your file it probably shows 86 characters. One method to see if it is properly terminated is to do "cat -v -e -t $FILENAME" and if the last line does not end with a $ it does not have a line terminator.
For people that have cut and pasted the example input file you very likely get 87 characters. To make a “bad” file you could use something like
mv Firstdata.dat Firstdata.dat.good
head --bytes=-1 Firstdata.dat.good >Firstdata.dat
or if your head(1) command cannot handle that option
to make the file with the missing line terminator that will cause an error with some compilers.
so the best practice is not to end a NAMELIST file with the last line being a NAMELIST group terminator as noted above, but I recommend it be a printable text line not a blank line that you add to the end of the file, or a sacrificial NAMELIST definition that you do not read like