mo_nml.f90

Go to the documentation of this file.

!> \file mo_nml.f90
!> \brief \copybrief mo_nml
!> \details \copydetails mo_nml
 
!> \brief Deal with namelist files.
!> \details This module provides routines to open, close and position namelist files.
!! - Adapted from Echam5, (C) MPI-MET, Hamburg, Germany
!> \author L. Kornblueh, MPI, March 2001, original source
!> \changelog
!! - Jan 2011, Matthias Cuntz
!!   - compatible with gfortran <= version 4.3
!!   - all integer(i4)
!!   - quiet
!! - Jan 2013, Matthias Cuntz
!!   - close_nml with unit, open_nml quiet=.true. default position_nml swap first and status
!> \authors Matthias Cuntz
!> \date Jan 2011
!> \copyright Copyright 2005-\today, the CHS Developers, Sabine Attinger: All rights reserved.
!! FORCES is released under the LGPLv3+ license \license_note
MODULE mo_nml
 
  USE mo_kind, ONLY : i4
  USE mo_string_utils, ONLY : tolower
  USE mo_message, ONLY : message, error_message
 
  IMPLICIT NONE
 
  PRIVATE
 
  PUBLIC :: open_nml                                      ! open namelist file
  PUBLIC :: close_nml                                     ! close namelist file
  PUBLIC :: position_nml                                  ! position namelist file
  PUBLIC :: nunitnml                                      ! namelist unit
  PUBLIC :: positioned, missing, length_error, read_error ! return values from position_nml
 
  ! return values in optinal status of function 'position_nml'
  !> Information: file pointer set to namelist group
  INTEGER(i4), PARAMETER :: positioned = 0
  !> Error: namelist group is missing
  INTEGER(i4), PARAMETER :: missing = 1
  !> Error: namelist group name too long
  INTEGER(i4), PARAMETER :: length_error = 2
  !> Error occured during read of namelist file
  INTEGER(i4), PARAMETER :: read_error = 3
 
  !> default namelist unit
  INTEGER, SAVE :: nunitnml = -1
 
  ! ------------------------------------------------------------------
 
CONTAINS
 
  ! ------------------------------------------------------------------
 
  !>    \brief Open a namelist file.
 
  !>    \details Open a namelist file.
  !!
  !!    \b Example
  !!
  !!    \code{.f90}
  !!    call open_nml('namelist.txt',nnml)
  !!    \endcode
  !!    See also example in test directory
 
  !>        \param[in] "character(len=*) :: file"   namelist filename
  !>        \param[in] "integer          :: unit"   namelist unit
  !>       \param[in] "logical, optional :: quiet"   Be verbose or not (default: .true.)\n
  !!                                                            .true.:  no messages\n
  !!                                                            .false.: write out messages
 
  !>    \author Matthias Cuntz
  !>    \date Dec 2011
  !!        - modified from Echam5, (C) MPI-MET, Hamburg, Germany
  !>    \date Jan 2013
  !!        - quiet=.true. default
  !>    \author Luis Samaniego
  !>    \date Nov 2013
  !!        - comparison statements == -> .eq., etc
 
  SUBROUTINE open_nml(file, unit, quiet)
 
    IMPLICIT NONE
 
    CHARACTER(len = *), INTENT(IN) :: file
    INTEGER, INTENT(IN) :: unit
    LOGICAL, INTENT(IN), OPTIONAL :: quiet
    INTEGER :: istat
    LOGICAL :: iquiet
 
    iquiet = .false.
    if (present(quiet)) iquiet = quiet
 
    nunitnml = unit
    if (.not. iquiet) CALL message('    This is namelist ', trim(file))
    OPEN (nunitnml, file = file, iostat = istat, status = 'old', action = 'read', delim = 'apostrophe')
 
    IF (istat .ne. 0) THEN
      CALL error_message('OPEN_NML: Could not open namelist file ', trim(file))
    END IF
 
  END SUBROUTINE open_nml
 
  ! ------------------------------------------------------------------
 
  !>    \brief Close a namelist file.
 
  !>    \details Close a namelist file.
  !!
  !!    \b Example
  !!
  !!    \code{.f90}
  !!    call close_nml()
  !!    ! or
  !!    call close_nml(unml)
  !!    \endcode
  !!    See also example in test directory
 
  !>    \param[in] "integer, optional :: unit"   namelist unit
 
  !>    \note
  !!    open_nml remembers the namelist unit in the public, save variable nunitnml.\n
  !!    close_nml uses nunitnml if unit is not given.
 
  !>    \author Matthias Cuntz
  !>    \date Dec 2011
  !!        - modified from Echam5, (C) MPI-MET, Hamburg, Germany
  !>    \date Jan 2013
  !!        - unit
  SUBROUTINE close_nml(unit)
 
    IMPLICIT NONE
 
    INTEGER, INTENT(IN), OPTIONAL :: unit
 
    INTEGER :: istat, nnml
 
    nnml = nunitnml
    if (present(unit)) nnml = unit
 
    IF (nnml .lt. 0) CALL error_message('CLOSE_NML: No namelist file opened.')
 
    CLOSE(nnml, iostat = istat)
 
    IF (istat .ne. 0) CALL error_message('CLOSE_NML: Could not close namelist file.')
 
    if (.not. present(unit)) nunitnml = -1
 
  END SUBROUTINE close_nml
 
  ! ------------------------------------------------------------------
 
  !>    \brief Position a namlist file.
 
  !>    \details Position namelist file pointer for reading a new namelist next.\n
  !!    It positions the namelist file at the correct place for reading\n
  !!    namelist /name/ (case independent).
  !!
  !!    \b Example
  !!
  !!    \code{.f90}
  !!    call position_nml('myname',nnml)
  !!    \endcode
 
  !>    \param[in] "character(len=*) :: name"     namelist name (case independent)
  !>    \param[in] "integer, optional :: unit"    namelist unit (default: nunitnml)
  !>    \param[in] "logical, optional :: first"   start search at beginning,
  !!                                              i.e. rewind the namelist first (default: .true.)\n
  !!                                              .true.:  rewind\n
  !!                                              .false.: continue search from current file pointer
  !>    \param[out] "integer(i4), optional :: status"   Set on output to either of\n
  !!                                                    POSITIONED (0)   - correct\n
  !!                                                    MISSING (1)      - name not found\n
  !!                                                    LENGTH_ERROR (2) - namelist length longer then 256 characters\n
  !!                                                    READ_ERROR (3)   - error while reading namelist file
 
  !>    \author Matthias Cuntz
  !>    \date Dec 2011
  !!        - modified from Echam5, (C) MPI-MET, Hamburg, Germany
  !>    \date Jan 2013
  !!        - swap first and status in call list
  SUBROUTINE position_nml(name, unit, status, first)
 
    IMPLICIT NONE
 
    CHARACTER(len = *), INTENT(in) :: name   ! namelist group name
    INTEGER, INTENT(in), OPTIONAL :: unit   ! file unit number
    INTEGER(i4), INTENT(out), OPTIONAL :: status ! error return value
    LOGICAL, INTENT(in), OPTIONAL :: first  ! default: true
 
    CHARACTER(len = 256) :: yline    ! line read
    CHARACTER(len = 256) :: test     ! uppercase namelist group name
    INTEGER(i4) :: stat     ! local copy of status variable
    INTEGER :: ios      ! status variable from read operation
    LOGICAL :: lrew     ! local copy of rewind flag
    INTEGER(i4) :: iunit    ! local copy of unit number
    INTEGER(i4) :: len_name ! length of requested namelist group name
    CHARACTER :: ytest    ! character to test for delimiter
    CHARACTER(len = 12) :: code     ! error code printed
    INTEGER(i4) :: ind      ! index from index routine
    INTEGER(i4) :: indc     ! index of comment character (!)
 
    lrew = .true.
    IF (PRESENT(first)) lrew = first
    iunit = nunitnml
    IF (PRESENT(unit)) iunit = unit
    stat = missing
    code = 'MISSING'
 
    len_name = len_trim(name)
 
    IF (len_name .gt. len(test)) THEN
      stat = length_error
      code = 'LENGTH_ERROR'
    END IF
 
    !test = '&'//tolower(name)
    write(test, '(A,A)') '&', tolower(name)
 
    ! Reposition file at beginning:
    IF (lrew) rewind(iunit)
 
    ! Search start of namelist
    DO
      IF (stat .ne. missing) EXIT
 
      yline = ' '
 
      READ (iunit, *, iostat = ios) yline
      IF (ios .lt. 0) THEN
        EXIT  ! MISSING
      ELSE IF (ios .gt. 0) THEN
        stat = read_error
        code = 'READ_ERROR'
        EXIT
      END IF
 
      yline = tolower(yline)
 
      ind = index(yline, trim(test))
 
      IF (ind .eq. 0) cycle
 
      indc = index(yline, '!')
 
      IF (indc .gt. 0 .AND. indc .lt. ind) cycle
 
      ! test for delimiter
      ytest = yline(ind + len_name + 1 : ind + len_name + 1)
 
      IF ((lge(ytest, '0') .AND. lle(ytest, '9')) .OR. &
              (lge(ytest, 'a') .AND. lle(ytest, 'z')) .OR. &
              ytest .eq. '_'                         .OR. &
              (lge(ytest, 'A') .AND. lle(ytest, 'Z'))) THEN
        cycle
      ELSE
        stat = positioned
        backspace(iunit)
        EXIT
      END IF
    END DO
 
    IF (PRESENT(status)) status = stat
    SELECT CASE (stat)
    CASE (positioned)
      RETURN
    CASE (missing)
      IF (PRESENT(status)) RETURN
    END SELECT
 
    ! Error if it reaches here
    CALL error_message('POSITION_NML: namelist /', trim(name) , '/ ', trim(code))
 
  END SUBROUTINE position_nml
 
END MODULE mo_nml