w90_readwrite_read_atoms Subroutine

public subroutine w90_readwrite_read_atoms(settings, atom_data, real_lattice, bohr, error, comm)

Uses

  • proc~~w90_readwrite_read_atoms~~UsesGraph proc~w90_readwrite_read_atoms w90_readwrite_read_atoms module~w90_error w90_error proc~w90_readwrite_read_atoms->module~w90_error module~w90_utility w90_utility proc~w90_readwrite_read_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

Arguments

Type IntentOptional Attributes Name
type(settings_type), intent(inout) :: settings
type(atom_data_type), intent(inout) :: atom_data
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~~w90_readwrite_read_atoms~~CallsGraph proc~w90_readwrite_read_atoms w90_readwrite_read_atoms proc~readwrite_get_atoms readwrite_get_atoms proc~w90_readwrite_read_atoms->proc~readwrite_get_atoms proc~set_error_alloc set_error_alloc proc~w90_readwrite_read_atoms->proc~set_error_alloc proc~set_error_dealloc set_error_dealloc proc~w90_readwrite_read_atoms->proc~set_error_dealloc proc~set_error_input set_error_input proc~w90_readwrite_read_atoms->proc~set_error_input proc~utility_cart_to_frac utility_cart_to_frac proc~w90_readwrite_read_atoms->proc~utility_cart_to_frac proc~w90_readwrite_get_block_length w90_readwrite_get_block_length proc~w90_readwrite_read_atoms->proc~w90_readwrite_get_block_length proc~w90_readwrite_get_keyword_vector w90_readwrite_get_keyword_vector proc~w90_readwrite_read_atoms->proc~w90_readwrite_get_keyword_vector proc~w90_readwrite_get_vector_length w90_readwrite_get_vector_length proc~w90_readwrite_read_atoms->proc~w90_readwrite_get_vector_length proc~w90_readwrite_set_atoms w90_readwrite_set_atoms proc~w90_readwrite_read_atoms->proc~w90_readwrite_set_atoms proc~readwrite_get_atoms->proc~set_error_alloc proc~readwrite_get_atoms->proc~set_error_input proc~readwrite_get_atoms->proc~utility_cart_to_frac proc~readwrite_get_atoms->proc~w90_readwrite_get_block_length 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~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_dealloc->proc~comms_sync_error proc~set_error_dealloc->proc~set_base_error proc~set_error_input->proc~comms_sync_error proc~set_error_input->proc~set_base_error proc~w90_readwrite_get_block_length->proc~set_error_input proc~w90_readwrite_get_keyword_vector->proc~set_error_input proc~set_error_fatal set_error_fatal proc~w90_readwrite_get_keyword_vector->proc~set_error_fatal proc~w90_readwrite_get_vector_length->proc~set_error_input proc~w90_readwrite_get_vector_length->proc~set_error_fatal proc~w90_readwrite_set_atoms->proc~set_error_alloc proc~utility_lowercase utility_lowercase proc~w90_readwrite_set_atoms->proc~utility_lowercase proc~set_error_fatal->proc~comms_sync_error proc~set_error_fatal->proc~set_base_error proc~utility_inv3 utility_inv3 proc~utility_inverse_mat->proc~utility_inv3

Called by

proc~~w90_readwrite_read_atoms~~CalledByGraph proc~w90_readwrite_read_atoms w90_readwrite_read_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 w90_readwrite_read_atoms(settings, atom_data, real_lattice, bohr, error, comm)
    use w90_error, only: w90_error_type, set_error_input, set_error_dealloc, set_error_alloc
    use w90_utility, only: utility_cart_to_frac

    implicit none

    ! arguments
    real(kind=dp), intent(in) :: bohr
    real(kind=dp), intent(in) :: real_lattice(3, 3)
    type(atom_data_type), intent(inout) :: atom_data
    type(settings_type), intent(inout) :: settings
    type(w90_comm_type), intent(in) :: comm
    type(w90_error_type), allocatable, intent(out) :: error

    ! local variables
    character(len=maxlen), allocatable :: atoms_label_tmp(:)
    integer :: i_temp, i_temp2, loop, nsymb, ierr
    logical :: found, found2, found3, lunits
    real(kind=dp), allocatable :: atoms_pos_cart_tmp(:, :)
    real(kind=dp), allocatable :: atoms_pos_frac_tmp(:, :)

    found = .false.
    found2 = .false.
    found3 = .false.

    if (allocated(settings%entries)) then
      call w90_readwrite_get_vector_length(settings, 'symbols', found, nsymb, error, comm)
      if (allocated(error)) return
      call w90_readwrite_get_vector_length(settings, 'atoms_cart', found2, i_temp, error, comm)
      if (allocated(error)) return
      call w90_readwrite_get_vector_length(settings, 'atoms_frac', found3, i_temp, error, comm)
      if (allocated(error)) return

      if (.not. (found .or. found2 .or. found3)) then
        return ! neither specified, not necessarily an error (only needed if projectors wanted)
      end if

      ! if supplied, need both entries: labels and positions
      if (.not. (found .and. (found2 .or. found3))) then
        call set_error_input(error, 'Error: Must specify both symbols and atoms_frac (or atoms_cart)', comm)
        return
      end if

      if (found) atom_data%num_atoms = nsymb ! shape of symbols is n, i_temp returns n

      allocate (atoms_label_tmp(atom_data%num_atoms), stat=ierr)
      if (ierr /= 0) then
        call set_error_alloc(error, 'Error in allocating atoms_label_tmp in w90_readwrite_read_atoms', comm)
        return
      end if
      allocate (atoms_pos_cart_tmp(3, atom_data%num_atoms), stat=ierr)
      if (ierr /= 0) then
        call set_error_alloc(error, 'Error in allocating atoms_pos_cart_tmp in w90_readwrite_read_atoms', comm)
        return
      end if

      ! get symbols list
      if (found) then
        call w90_readwrite_get_keyword_vector(settings, 'symbols', found, i_temp, error, comm, &
                                              c2_value=atoms_label_tmp)
        if (allocated(error)) return
      end if

      if (found2) then
        call w90_readwrite_get_keyword_vector(settings, 'atoms_cart', found, i_temp, error, comm, &
                                              r2_value=atoms_pos_cart_tmp)
        if (allocated(error)) return
      end if

      if (found3) then
        allocate (atoms_pos_frac_tmp(3, atom_data%num_atoms), stat=ierr)
        if (ierr /= 0) then
          call set_error_alloc(error, 'Error in allocating atoms_pos_frac_tmp in w90_readwrite_read_atoms', comm)
          return
        end if

        call w90_readwrite_get_keyword_vector(settings, 'atoms_frac', found, i_temp, error, comm, &
                                              r2_value=atoms_pos_frac_tmp)
        if (allocated(error)) return

        do loop = 1, atom_data%num_atoms
          call utility_cart_to_frac(atoms_pos_frac_tmp(:, loop), &
                                    atoms_pos_cart_tmp(:, loop), transpose(real_lattice))
        end do
        deallocate (atoms_pos_frac_tmp, stat=ierr)
        if (ierr /= 0) then
          call set_error_dealloc(error, 'Error in deallocating atoms_pos_frac_tmp in w90_readwrite_read_atoms', comm)
          return
        end if

      end if

      call w90_readwrite_set_atoms(atom_data, atoms_label_tmp, atoms_pos_cart_tmp, error, comm)
      if (allocated(error)) return

      deallocate (atoms_label_tmp, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating atoms_label_tmp in w90_readwrite_read_atoms', comm)
        return
      end if
      deallocate (atoms_pos_cart_tmp, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating atoms_pos_cart_tmp in w90_readwrite_read_atoms', comm)
        return
      end if

      return ! no futher action in library mode
    end if

    i_temp = 0
    i_temp2 = 0
    found = .false.
    found2 = .false.

    ! Atoms
    call w90_readwrite_get_block_length(settings, 'atoms_frac', found, i_temp, error, comm)
    if (allocated(error)) return
    call w90_readwrite_get_block_length(settings, 'atoms_cart', found2, i_temp2, error, comm, lunits)
    if (allocated(error)) return

    if (found .and. found2) then
      call set_error_input(error, 'Error: Cannot specify both atoms_frac and atoms_cart', comm)
      return
    elseif (found .and. i_temp > 0) then
      lunits = .false.
      atom_data%num_atoms = i_temp
    elseif (found2 .and. i_temp2 > 0) then
      atom_data%num_atoms = i_temp2
      ! when units are specified, one fewer line than the total contains atom information
      if (lunits) atom_data%num_atoms = atom_data%num_atoms - 1
    end if
    if (atom_data%num_atoms > 0) then
      call readwrite_get_atoms(settings, atom_data, lunits, real_lattice, bohr, error, comm)
      if (allocated(error)) return
    end if
  end subroutine w90_readwrite_read_atoms