param_get_block_length Subroutine

private subroutine param_get_block_length(keyword, found, rows, lunits)

Uses

  • proc~~param_get_block_length~~UsesGraph proc~param_get_block_length param_get_block_length module~w90_io w90_io proc~param_get_block_length->module~w90_io module~w90_constants w90_constants module~w90_io->module~w90_constants

Finds the length of the data block

Arguments

Type IntentOptional AttributesName
character(len=*), intent(in) :: keyword

Keyword to examine

logical, intent(out) :: found

Is keyword present

integer, intent(out) :: rows

Number of rows

logical, intent(out), optional :: lunits

Have we found a unit specification


Called by

proc~~param_get_block_length~~CalledByGraph proc~param_get_block_length param_get_block_length proc~param_get_atoms param_get_atoms proc~param_get_atoms->proc~param_get_block_length proc~param_read param_read proc~param_read->proc~param_get_block_length proc~param_read->proc~param_get_atoms program~wannier wannier program~wannier->proc~param_read proc~wannier_run wannier_run proc~wannier_run->proc~param_read proc~wannier_setup wannier_setup proc~wannier_setup->proc~param_read program~postw90 postw90 program~postw90->proc~param_read

Contents


Source Code

  subroutine param_get_block_length(keyword, found, rows, lunits)
    !=====================================================!
    !                                                     !
    !! Finds the length of the data block
    !                                                     !
    !=====================================================!

    use w90_io, only: io_error

    implicit none

    character(*), intent(in)  :: keyword
    !! Keyword to examine
    logical, intent(out) :: found
    !! Is keyword present
    integer, intent(out) :: rows
    !! Number of rows
    logical, optional, intent(out) :: lunits
    !! Have we found a unit specification

    integer           :: i, in, ins, ine, loop, line_e, line_s
    logical           :: found_e, found_s
    character(len=maxlen) :: end_st, start_st, dummy
    character(len=2)  :: atsym
    real(kind=dp)     :: atpos(3)

    rows = 0
    found_s = .false.
    found_e = .false.

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

    do loop = 1, num_lines
      ins = index(in_data(loop), trim(keyword))
      if (ins == 0) cycle
      in = index(in_data(loop), 'begin')
      if (in == 0 .or. in > 1) cycle
      line_s = loop
      if (found_s) then
        call io_error('Error: Found '//trim(start_st)//' more than once in input file')
      endif
      found_s = .true.
    end do

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

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

    if (.not. found_e) then
      call io_error('Error: Found '//trim(start_st)//' but no '//trim(end_st)//' in input file')
    end if

    if (line_e <= line_s) then
      call io_error('Error: '//trim(end_st)//' comes before '//trim(start_st)//' in input file')
    end if

    rows = line_e - line_s - 1

    found = .true.

    ! Ignore atoms_cart and atoms_frac blocks if running in library mode
    if (library) then
      if (trim(keyword) .eq. 'atoms_cart' .or. trim(keyword) .eq. 'atoms_frac') then
        in_data(line_s:line_e) (1:maxlen) = ' '
      endif
    endif

    if (present(lunits)) then
      dummy = in_data(line_s + 1)
      !       write(stdout,*) dummy
      !       write(stdout,*) trim(dummy)
      read (dummy, *, end=555) atsym, (atpos(i), i=1, 3)
      lunits = .false.
    endif

    if (rows <= 0) then !cope with empty blocks
      found = .false.
      in_data(line_s:line_e) (1:maxlen) = ' '
    end if

    return

555 lunits = .true.

    if (rows <= 1) then !cope with empty blocks
      found = .false.
      in_data(line_s:line_e) (1:maxlen) = ' '
    end if

    return

  end subroutine param_get_block_length