Fortran namelist is a I/O method introduced in Fortran 77. It later became a standard in Fortran 90. It allows to read/write data as a dictionary like in plain text files. See below for a simple example:
SOMENAME_NML&
opt1=value1
opt2=value2
...=...
/
Derived types are user defined types. They extend the basic types REAL, INTEGER and LOGICAL. They can be customized to accommodate any sort of user requirement. Fortunately, those can also integrate namelists. Below you will find how to read a namelist file and directly pass the values into the derived type.
So first, let’s define a Derived type and link:
TYPE t_sf_weather
INTEGER :: nc
REAL(wp), ALLOCATABLE :: t_air_min_c(:)
REAL(wp), ALLOCATABLE :: t_air_max_c(:)
REAL(wp), ALLOCATABLE :: precip_daily_mmd(:)
REAL(wp), ALLOCATABLE :: wind(:) !< [m/min]
CONTAINS
PROCEDURE, PASS :: READ => read_weather !< Customized read for namelist
GENERIC, PUBLIC :: READ(FORMATTED) => READ
END TYPE t_sf_weather
Let’s implement the custom read for a namelist:
SUBROUTINE read_weather (dtv, unit, iotype, v_list, iostat, iomsg)
CLASS(t_sf_weather), INTENT(INOUT) :: dtv
INTEGER, INTENT(IN) :: unit
CHARACTER(*), INTENT(IN) :: iotype
INTEGER, INTENT(IN) :: v_list(:)
INTEGER, INTENT(OUT) :: iostat
CHARACTER(*), INTENT(INOUT) :: iomsg
CHARACTER(LEN=200) :: err_msg
READ (unit, *, IOSTAT=iostat, iomsg=err_msg) dtv%t_air_min_c
IF (iostat/=0 ) write(*,*) "Error 1: " // err_msg
READ (unit, *, IOSTAT=iostat) dtv%t_air_max_c(:)
IF (iostat/=0 ) write(*,*) "Error 2: " // err_msg
READ (unit, *, IOSTAT=iostat) dtv%precip_daily_mmd(:)
IF (iostat/=0 ) write(*,*) "Error 3: " // err_msg
READ (unit, *, IOSTAT=iostat) dtv%wind(:)
IF (iostat/=0 ) write(*,*) "Error 4: " // err_msg
END SUBROUTINE read_weather
Main method to read the namelist:
SUBROUTINE read_namelist(filename, weather)
CHARACTER(*), INTENT(in) :: filename
TYPE(t_sf_weather), INTENT(inout) :: weather
NAMELIST /WEATHER_NML/ weather !< The new method read_weather is called here
! Does the file exists?
INQUIRE(file=filename, iostat=status)
IF (status /= 0) THEN ! all good?
write(*,*) "'Inquire' error number: ", status
CALL finish("read_namelist", "Input error, file '"// filename // "' does not exists.")
END IF
! open to read
OPEN(action='read', file=filename, iostat=status, newunit=funit)
IF (status /= 0) THEN ! all good?
write(*,*) "'Open' error number: ", status
CALL finish("read_namelist", "Open error for file '"// filename // "'")
END IF
! read the namelist. Values are directly mapped into the derived type
READ(nml=WEATHER_NML, iostat=status, unit=funit, iomsg=err_msg)
IF (status /= 0) THEN ! all good?
write(*,*) "'Read' error number: ", status, ", message=", err_msg
CALL finish("read_namelist", "Read error for file '"// filename // "'")
END IF
CLOSE(funit) ! Formally close the file
END SUBROUTINE read_namelist
See how the namelist file would look like:
WEATHER_NML&
weather = 30, 15, 0, 2.1
/