readwrite_get_atoms Subroutine

private subroutine readwrite_get_atoms(settings, atom_data, lunits, real_lattice, bohr, error, comm)

Uses

  • proc~~readwrite_get_atoms~~UsesGraph proc~readwrite_get_atoms readwrite_get_atoms module~w90_error w90_error proc~readwrite_get_atoms->module~w90_error module~w90_utility w90_utility proc~readwrite_get_atoms->module~w90_utility 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_utility->module~w90_comms module~w90_constants w90_constants module~w90_utility->module~w90_constants module~w90_comms->module~w90_constants module~w90_comms->module~w90_error_base

Fills the atom data block

Arguments

Type IntentOptional Attributes Name
type(settings_type), intent(inout) :: settings
type(atom_data_type), intent(inout) :: atom_data
logical, intent(in) :: lunits

Do we expect a first line with the units
real(kind=dp), intent(in) :: real_lattice(3,3)
real(kind=dp), intent(in) :: bohr
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~readwrite_get_atoms~~CallsGraph proc~readwrite_get_atoms readwrite_get_atoms proc~set_error_alloc set_error_alloc proc~readwrite_get_atoms->proc~set_error_alloc proc~set_error_input set_error_input proc~readwrite_get_atoms->proc~set_error_input proc~utility_cart_to_frac utility_cart_to_frac proc~readwrite_get_atoms->proc~utility_cart_to_frac proc~utility_frac_to_cart utility_frac_to_cart proc~readwrite_get_atoms->proc~utility_frac_to_cart proc~utility_inverse_mat utility_inverse_mat proc~readwrite_get_atoms->proc~utility_inverse_mat proc~w90_readwrite_get_block_length w90_readwrite_get_block_length proc~readwrite_get_atoms->proc~w90_readwrite_get_block_length proc~comms_sync_error comms_sync_error proc~set_error_alloc->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_alloc->proc~set_base_error proc~set_error_input->proc~comms_sync_error proc~set_error_input->proc~set_base_error proc~utility_inv3 utility_inv3 proc~utility_inverse_mat->proc~utility_inv3 proc~w90_readwrite_get_block_length->proc~set_error_input

Called by

proc~~readwrite_get_atoms~~CalledByGraph proc~readwrite_get_atoms readwrite_get_atoms proc~w90_readwrite_read_atoms w90_readwrite_read_atoms proc~w90_readwrite_read_atoms->proc~readwrite_get_atoms proc~w90_postw90_readwrite_read w90_postw90_readwrite_read proc~w90_postw90_readwrite_read->proc~w90_readwrite_read_atoms proc~w90_wannier90_readwrite_read_special w90_wannier90_readwrite_read_special proc~w90_wannier90_readwrite_read_special->proc~w90_readwrite_read_atoms proc~input_reader_special input_reader_special proc~input_reader_special->proc~w90_wannier90_readwrite_read_special proc~w90_input_setopt w90_input_setopt proc~w90_input_setopt->proc~w90_wannier90_readwrite_read_special program~postw90 postw90 program~postw90->proc~w90_postw90_readwrite_read 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

Source Code

  subroutine readwrite_get_atoms(settings, atom_data, lunits, real_lattice, bohr, error, comm)
    !================================================!
    !
    !!   Fills the atom data block
    !
    !================================================!

    use w90_utility, only: utility_frac_to_cart, utility_cart_to_frac, utility_inverse_mat
    use w90_error, only: w90_error_type, set_error_input, set_error_alloc
    implicit none

    type(atom_data_type), intent(inout) :: atom_data
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm
    type(settings_type), intent(inout) :: settings
    logical, intent(in) :: lunits
    !! Do we expect a first line with the units
    real(kind=dp), intent(in) :: real_lattice(3, 3)
    real(kind=dp), intent(in) :: bohr

    real(kind=dp)     :: inv_lattice(3, 3)
    real(kind=dp)     :: atoms_pos_frac_tmp(3, atom_data%num_atoms)
    real(kind=dp)     :: atoms_pos_cart_tmp(3, atom_data%num_atoms)
    character(len=20) :: keyword
    integer           :: in, ins, ine, loop, i, line_e, line_s, counter
    integer           :: i_temp, loop2, max_sites, ierr, ic
    logical           :: found_e, found_s, found, frac
    character(len=maxlen) :: dummy, end_st, start_st
    character(len=maxlen) :: ctemp(atom_data%num_atoms)
    character(len=maxlen) :: atoms_label_tmp(atom_data%num_atoms)
    logical           :: lconvert

    call utility_inverse_mat(real_lattice, inv_lattice)

    keyword = "atoms_cart"
    frac = .false.
    call w90_readwrite_get_block_length(settings, "atoms_frac", found, i_temp, error, comm)
    if (allocated(error)) return
    if (found) then
      keyword = "atoms_frac"
      frac = .true.
    end if

    found_s = .false.
    found_e = .false.

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

    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

    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

    lconvert = .false.
    if (lunits) 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 atoms_cart not recognised in readwrite_get_atoms', comm)
        return
      end if
      settings%in_data(line_s) (1:maxlen) = ' '
      line_s = line_s + 1
    end if

    counter = 0
    do loop = line_s + 1, line_e - 1
      dummy = settings%in_data(loop)
      counter = counter + 1
      if (frac) then
        read (dummy, *, err=240, end=240) atoms_label_tmp(counter), (atoms_pos_frac_tmp(i, counter), i=1, 3)
      else
        read (dummy, *, err=240, end=240) atoms_label_tmp(counter), (atoms_pos_cart_tmp(i, counter), i=1, 3)
      end if
    end do

    if (lconvert) atoms_pos_cart_tmp = atoms_pos_cart_tmp*bohr

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

    if (frac) then
      do loop = 1, atom_data%num_atoms
        call utility_frac_to_cart(atoms_pos_frac_tmp(:, loop), atoms_pos_cart_tmp(:, loop), real_lattice)
      end do
    else
      do loop = 1, atom_data%num_atoms
        call utility_cart_to_frac(atoms_pos_cart_tmp(:, loop), atoms_pos_frac_tmp(:, loop), inv_lattice)
      end do
    end if

    ! Now we sort the data into the proper structures
    atom_data%num_species = 1
    ctemp(1) = atoms_label_tmp(1)
    do loop = 2, atom_data%num_atoms
      do loop2 = 1, loop - 1
        if (trim(atoms_label_tmp(loop)) == trim(atoms_label_tmp(loop2))) exit
        if (loop2 == loop - 1) then
          atom_data%num_species = atom_data%num_species + 1
          ctemp(atom_data%num_species) = atoms_label_tmp(loop)
        end if
      end do
    end do

    allocate (atom_data%species_num(atom_data%num_species), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating atoms_species_num in readwrite_get_atoms', comm)
      return
    end if
    allocate (atom_data%label(atom_data%num_species), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating atoms_label in readwrite_get_atoms', comm)
      return
    end if
    allocate (atom_data%symbol(atom_data%num_species), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating atoms_symbol in readwrite_get_atoms', comm)
      return
    end if
    atom_data%species_num(:) = 0

    do loop = 1, atom_data%num_species
      atom_data%label(loop) = ctemp(loop)
      do loop2 = 1, atom_data%num_atoms
        if (trim(atom_data%label(loop)) == trim(atoms_label_tmp(loop2))) then
          atom_data%species_num(loop) = atom_data%species_num(loop) + 1
        end if
      end do
    end do

    max_sites = maxval(atom_data%species_num)
    allocate (atom_data%pos_cart(3, max_sites, atom_data%num_species), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating atoms_pos_cart in readwrite_get_atoms', comm)
      return
    end if

    do loop = 1, atom_data%num_species
      counter = 0
      do loop2 = 1, atom_data%num_atoms
        if (trim(atom_data%label(loop)) == trim(atoms_label_tmp(loop2))) then
          counter = counter + 1
          !atom_data%pos_frac(:, counter, loop) = atoms_pos_frac_tmp(:, loop2)
          atom_data%pos_cart(:, counter, loop) = atoms_pos_cart_tmp(:, loop2)
        end if
      end do
    end do

    ! Strip any numeric characters from atoms_label to get atoms_symbol
    do loop = 1, atom_data%num_species
      atom_data%symbol(loop) (1:2) = atom_data%label(loop) (1:2)
      ic = ichar(atom_data%symbol(loop) (2:2))
      if ((ic .lt. ichar('a')) .or. (ic .gt. ichar('z'))) &
        atom_data%symbol(loop) (2:2) = ' '
    end do

    return

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