w90_readwrite_get_keyword_block Subroutine

public subroutine w90_readwrite_get_keyword_block(settings, keyword, found, rows, columns, bohr, error, comm, c_value, l_value, i_value, r_value)

Uses

  • proc~~w90_readwrite_get_keyword_block~~UsesGraph proc~w90_readwrite_get_keyword_block w90_readwrite_get_keyword_block module~w90_error w90_error proc~w90_readwrite_get_keyword_block->module~w90_error module~w90_comms w90_comms module~w90_error->module~w90_comms module~w90_error_base w90_error_base module~w90_error->module~w90_error_base module~w90_comms->module~w90_error_base module~w90_constants w90_constants module~w90_comms->module~w90_constants

Finds the values of the required data block

Arguments

Type IntentOptional Attributes Name
type(settings_type), intent(inout) :: settings
character(len=*), intent(in) :: keyword

Keyword to examine
logical, intent(out) :: found

Is keyword present
integer, intent(in) :: rows

Number of rows
integer, intent(in) :: columns

Number of columns
real(kind=dp), intent(in) :: bohr
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm
character(len=*), intent(inout), optional :: c_value(columns,rows)

keyword block data
logical, intent(inout), optional :: l_value(columns,rows)

keyword block data
integer, intent(inout), optional :: i_value(columns,rows)

keyword block data
real(kind=dp), intent(inout), optional :: r_value(columns,rows)

keyword block data

Calls

proc~~w90_readwrite_get_keyword_block~~CallsGraph proc~w90_readwrite_get_keyword_block w90_readwrite_get_keyword_block proc~set_error_fatal set_error_fatal proc~w90_readwrite_get_keyword_block->proc~set_error_fatal proc~set_error_input set_error_input proc~w90_readwrite_get_keyword_block->proc~set_error_input proc~comms_sync_error comms_sync_error proc~set_error_fatal->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_fatal->proc~set_base_error proc~set_error_input->proc~comms_sync_error proc~set_error_input->proc~set_base_error

Called by

proc~~w90_readwrite_get_keyword_block~~CalledByGraph proc~w90_readwrite_get_keyword_block w90_readwrite_get_keyword_block proc~w90_readwrite_read_explicit_kpath_points w90_readwrite_read_explicit_kpath_points proc~w90_readwrite_read_explicit_kpath_points->proc~w90_readwrite_get_keyword_block proc~w90_readwrite_read_kpoints w90_readwrite_read_kpoints proc~w90_readwrite_read_kpoints->proc~w90_readwrite_get_keyword_block proc~w90_readwrite_read_lattice w90_readwrite_read_lattice proc~w90_readwrite_read_lattice->proc~w90_readwrite_get_keyword_block proc~w90_wannier90_readwrite_read_disentangle w90_wannier90_readwrite_read_disentangle proc~w90_wannier90_readwrite_read_disentangle->proc~w90_readwrite_get_keyword_block proc~w90_wannier90_readwrite_read_explicit_kpts w90_wannier90_readwrite_read_explicit_kpts proc~w90_wannier90_readwrite_read_explicit_kpts->proc~w90_readwrite_get_keyword_block proc~w90_postw90_readwrite_read w90_postw90_readwrite_read proc~w90_postw90_readwrite_read->proc~w90_readwrite_read_kpoints proc~w90_postw90_readwrite_read->proc~w90_readwrite_read_lattice proc~w90_readwrite_read_explicit_kpath w90_readwrite_read_explicit_kpath proc~w90_readwrite_read_explicit_kpath->proc~w90_readwrite_read_explicit_kpath_points proc~w90_wannier90_readwrite_read w90_wannier90_readwrite_read proc~w90_wannier90_readwrite_read->proc~w90_wannier90_readwrite_read_disentangle proc~w90_wannier90_readwrite_read->proc~w90_readwrite_read_explicit_kpath proc~w90_wannier90_readwrite_read_special w90_wannier90_readwrite_read_special proc~w90_wannier90_readwrite_read_special->proc~w90_readwrite_read_kpoints proc~w90_wannier90_readwrite_read_special->proc~w90_readwrite_read_lattice proc~w90_wannier90_readwrite_read_special->proc~w90_wannier90_readwrite_read_explicit_kpts proc~input_reader_special input_reader_special proc~input_reader_special->proc~w90_wannier90_readwrite_read_special proc~w90_input_reader~2 w90_input_reader proc~w90_input_reader~2->proc~w90_wannier90_readwrite_read proc~w90_input_setopt w90_input_setopt proc~w90_input_setopt->proc~w90_wannier90_readwrite_read proc~w90_input_setopt->proc~w90_wannier90_readwrite_read_special program~postw90 postw90 program~postw90->proc~w90_postw90_readwrite_read proc~w90_input_reader w90_input_reader proc~w90_input_reader->proc~w90_input_reader~2 proc~w90_input_setopt_f w90_input_setopt_f proc~w90_input_setopt_f->proc~w90_input_setopt program~wannier wannier program~wannier->proc~input_reader_special program~wannier->proc~w90_input_reader~2

Source Code

  subroutine w90_readwrite_get_keyword_block(settings, keyword, found, rows, columns, bohr, error, comm, &
                                             c_value, l_value, i_value, r_value)
    !================================================!
    !
    !!   Finds the values of the required data block
    ! i.e. matrix data
    ! applies to: dis_spheres, kpoints, nnkpts, unit_cell_cart
    !
    !================================================!

    use w90_error, only: w90_error_type, set_error_input, set_error_fatal

    implicit none

    character(*), intent(in)  :: keyword
    !! Keyword to examine
    logical, intent(out) :: found
    !! Is keyword present
    integer, intent(in)  :: rows
    !! Number of rows
    integer, intent(in)  :: columns
    !! Number of columns
    character(*), optional, intent(inout) :: c_value(columns, rows)
    !! keyword block data
    logical, optional, intent(inout) :: l_value(columns, rows)
    !! keyword block data
    integer, optional, intent(inout) :: i_value(columns, rows)
    !! keyword block data
    real(kind=dp), optional, intent(inout) :: r_value(columns, rows)
    !! keyword block data
    real(kind=dp), intent(in) :: bohr
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm
    type(settings_type), intent(inout) :: settings

    integer :: in, ins, ine, loop, i, line_e, line_s, counter, blen
    logical :: found_e, found_s, lconvert
    character(len=maxlen) :: dummy, end_st, start_st

    found_s = .false.
    found_e = .false.

    start_st = 'begin '//trim(keyword)
    end_st = 'end '//trim(keyword)

    if (allocated(settings%entries) .and. allocated(settings%in_data)) then
      call set_error_fatal(error, 'Error: (library use) options interface and .win parsing clash.'// &
                           '  See library documentation "setting options." (readwrite.F90)', comm)
      return
    elseif (allocated(settings%entries)) then

      do loop = 1, settings%num_entries  ! this means the first occurance of the variable in settings is used
        if (settings%entries(loop)%keyword == keyword) then
          if (present(i_value)) then
            i_value = settings%entries(loop)%i2d
          else if (present(r_value)) then
            r_value = settings%entries(loop)%r2d
          else
            call set_error_fatal(error, 'Error: block sought, but no variable provided to assign to. (readwrite.F90)', comm)
            return
          end if
          found = .true.
        end if
      end do

    else if (allocated(settings%in_data)) then
      do loop = 1, settings%num_lines
        ins = index(settings%in_data(loop), trim(keyword))
        if (ins == 0) cycle
        in = index(settings%in_data(loop), 'begin')
        if (in == 0 .or. in > 1) cycle
        line_s = loop
        if (found_s) then
          call set_error_input(error, 'Error: Found '//trim(start_st)//' more than once in input file', comm)
          return
        end if
        found_s = .true.
      end do

      if (.not. found_s) then
        found = .false.
        return
      end if

      do loop = 1, settings%num_lines
        ine = index(settings%in_data(loop), trim(keyword))
        if (ine == 0) cycle
        in = index(settings%in_data(loop), 'end')
        if (in == 0 .or. in > 1) cycle
        line_e = loop
        if (found_e) then
          call set_error_input(error, 'Error: Found '//trim(end_st)//' more than once in input file', comm)
          return
        end if
        found_e = .true.
      end do

      if (.not. found_e) then
        call set_error_input(error, 'Error: Found '//trim(start_st)//' but no '//trim(end_st)//' in input file', comm)
        return
      end if

      if (line_e <= line_s) then
        call set_error_input(error, 'Error: '//trim(end_st)//' comes before '//trim(start_st)//' in input file', comm)
        return
      end if

      ! number of lines of data in block
      blen = line_e - line_s - 1

      !    if( blen /= rows) then
      !       if ( index(trim(keyword),'unit_cell_cart').ne.0 ) then
      !          if ( blen /= rows+1 ) call io_error('Error: Wrong number of lines in block '//trim(keyword))
      !       else
      !          call io_error('Error: Wrong number of lines in block '//trim(keyword))
      !       endif
      !    endif

      if ((blen .ne. rows) .and. (blen .ne. rows + 1) .and. (rows .gt. 0)) then
        call set_error_input(error, 'Error: Wrong number of lines in block '//trim(keyword), comm)
        return
      end if

      if ((blen .eq. rows + 1) .and. (rows .gt. 0) .and. &
          (index(trim(keyword), 'unit_cell_cart') .eq. 0)) then
        call set_error_input(error, 'Error: Wrong number of lines in block '//trim(keyword), comm)
        return
      end if

      found = .true.

      lconvert = .false.
      if (blen == rows + 1) then
        dummy = settings%in_data(line_s + 1)
        if (index(dummy, 'ang') .ne. 0) then
          lconvert = .false.
        elseif (index(dummy, 'bohr') .ne. 0) then
          lconvert = .true.
        else
          call set_error_input(error, 'Error: Units in block '//trim(keyword)//' not recognised', comm)
          return
        end if
        settings%in_data(line_s) (1:maxlen) = ' '
        line_s = line_s + 1
      end if

      !    r_value=1.0_dp
      counter = 0
      do loop = line_s + 1, line_e - 1
        dummy = settings%in_data(loop)
        counter = counter + 1
        if (present(c_value)) read (dummy, *, err=240, end=240) (c_value(i, counter), i=1, columns)
        if (present(l_value)) then
          ! I don't think we need this. Maybe read into a dummy charater
          ! array and convert each element to logical
          call set_error_input(error, 'w90_readwrite_get_keyword_block unimplemented for logicals', comm)
          return
        end if
        if (present(i_value)) read (dummy, *, err=240, end=240) (i_value(i, counter), i=1, columns)
        if (present(r_value)) read (dummy, *, err=240, end=240) (r_value(i, counter), i=1, columns)
      end do

      if (lconvert) then
        if (present(r_value)) then
          r_value = r_value*bohr
        end if
      end if

      settings%in_data(line_s:line_e) (1:maxlen) = ' '
    end if
    return

240 call set_error_input(error, 'Error: Problem reading block keyword '//trim(keyword), comm)
    return
  end subroutine w90_readwrite_get_keyword_block