Fills the atom data block during a library call
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
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 |
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