param_lib_set_atoms Subroutine

public subroutine param_lib_set_atoms(atoms_label_tmp, atoms_pos_cart_tmp)

Uses

  • proc~~param_lib_set_atoms~~UsesGraph proc~param_lib_set_atoms param_lib_set_atoms module~w90_utility w90_utility proc~param_lib_set_atoms->module~w90_utility module~w90_io w90_io proc~param_lib_set_atoms->module~w90_io module~w90_constants w90_constants module~w90_utility->module~w90_constants module~w90_io->module~w90_constants

Fills the atom data block during a library call

Arguments

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

Atom labels

real(kind=dp), intent(in) :: atoms_pos_cart_tmp(3,num_atoms)

Atom positions


Calls

proc~~param_lib_set_atoms~~CallsGraph proc~param_lib_set_atoms param_lib_set_atoms proc~utility_lowercase utility_lowercase proc~param_lib_set_atoms->proc~utility_lowercase

Called by

proc~~param_lib_set_atoms~~CalledByGraph proc~param_lib_set_atoms param_lib_set_atoms proc~wannier_run wannier_run proc~wannier_run->proc~param_lib_set_atoms proc~wannier_setup wannier_setup proc~wannier_setup->proc~param_lib_set_atoms

Contents

Source Code


Source Code

  subroutine param_lib_set_atoms(atoms_label_tmp, atoms_pos_cart_tmp)
    !=====================================================!
    !                                                     !
    !!   Fills the atom data block during a library call
    !                                                     !
    !=====================================================!

    use w90_utility, only: utility_cart_to_frac, utility_lowercase
    use w90_io, only: io_error

    implicit none

    character(len=*), intent(in) :: atoms_label_tmp(num_atoms)
    !! Atom labels
    real(kind=dp), intent(in)      :: atoms_pos_cart_tmp(3, num_atoms)
    !! Atom positions

    real(kind=dp)     :: atoms_pos_frac_tmp(3, num_atoms)
    integer           :: loop2, max_sites, ierr, ic, loop, counter
    character(len=maxlen) :: ctemp(num_atoms)
    character(len=maxlen) :: tmp_string

    do loop = 1, num_atoms
      call utility_cart_to_frac(atoms_pos_cart_tmp(:, loop), &
                                atoms_pos_frac_tmp(:, loop), recip_lattice)
    enddo

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

    allocate (atoms_species_num(num_species), stat=ierr)
    if (ierr /= 0) call io_error('Error allocating atoms_species_num in param_lib_set_atoms')
    allocate (atoms_label(num_species), stat=ierr)
    if (ierr /= 0) call io_error('Error allocating atoms_label in param_lib_set_atoms')
    allocate (atoms_symbol(num_species), stat=ierr)
    if (ierr /= 0) call io_error('Error allocating atoms_symbol in param_lib_set_atoms')
    atoms_species_num(:) = 0

    do loop = 1, num_species
      atoms_label(loop) = ctemp(loop)
      do loop2 = 1, num_atoms
        if (trim(atoms_label(loop)) == trim(atoms_label_tmp(loop2))) then
          atoms_species_num(loop) = atoms_species_num(loop) + 1
        end if
      end do
    end do

    max_sites = maxval(atoms_species_num)
    allocate (atoms_pos_frac(3, max_sites, num_species), stat=ierr)
    if (ierr /= 0) call io_error('Error allocating atoms_pos_frac in param_lib_set_atoms')
    allocate (atoms_pos_cart(3, max_sites, num_species), stat=ierr)
    if (ierr /= 0) call io_error('Error allocating atoms_pos_cart in param_lib_set_atoms')

    do loop = 1, num_species
      counter = 0
      do loop2 = 1, num_atoms
        if (trim(atoms_label(loop)) == trim(atoms_label_tmp(loop2))) then
          counter = counter + 1
          atoms_pos_frac(:, counter, loop) = atoms_pos_frac_tmp(:, loop2)
          atoms_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, num_species
      atoms_symbol(loop) (1:2) = atoms_label(loop) (1:2)
      ic = ichar(atoms_symbol(loop) (2:2))
      if ((ic .lt. ichar('a')) .or. (ic .gt. ichar('z'))) &
        atoms_symbol(loop) (2:2) = ' '
      tmp_string = trim(adjustl(utility_lowercase(atoms_symbol(loop))))
      atoms_symbol(loop) (1:2) = tmp_string(1:2)
      tmp_string = trim(adjustl(utility_lowercase(atoms_label(loop))))
      atoms_label(loop) (1:2) = tmp_string(1:2)
    end do

    return

  end subroutine param_lib_set_atoms