aselimov/CACmb
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Latest updates

Browse Source
This commit is contained in:
Alex Selimov 2023-02-24 22:36:09 -05:00
parent d6f11590f3
commit 8e924e1658
13 changed files with 338 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Makefile
View File

@ -33,7 +33,7 @@ $(OBJDIR)/%.o: %.f90
deps: deps:
@fortdepend -o Makefile.dep -i mpi -b obj -w @makedepf90 -b obj *.f90 > Makefile.dep
#----------------- CLEAN UP -----------------# #----------------- CLEAN UP -----------------#

2
src/caller.f90
View File

@ -60,6 +60,8 @@ module caller
call group(arg_pos) call group(arg_pos)
case('-ow') case('-ow')
arg_pos = arg_pos + 1 arg_pos = arg_pos + 1
case('-novel')
arg_pos = arg_pos+1
case('-wrap') case('-wrap')
arg_pos = arg_pos + 1 arg_pos = arg_pos + 1
case('-norefine') case('-norefine')

92
src/elements.f90
View File

@ -437,7 +437,7 @@ module elements
real(kind=dp), dimension(3, max_basisnum*max_esize**3), intent(out) :: r_interp !Interpolated atomic positions real(kind=dp), dimension(3, max_basisnum*max_esize**3), intent(out) :: r_interp !Interpolated atomic positions
real(kind = dp), optional, intent(in) :: eng(:,:), f(:,:,:), & real(kind = dp), optional, intent(in) :: eng(:,:), f(:,:,:), &
v(:,:,:) v(:,:,:)
real(kind=dp), dimension(10, max_basisnum*max_esize**3), optional,intent(out) :: data_interp !Interpolated atomic positions real(kind=dp), dimension(:,:), optional,intent(out) :: data_interp !Interpolated atomic positions
!Internal variables !Internal variables
integer :: it, is, ir, ibasis, inod, ia, bnum, lat_type_temp, adjust integer :: it, is, ir, ibasis, inod, ia, bnum, lat_type_temp, adjust
@ -528,6 +528,68 @@ module elements
return return
end subroutine interpolate_atoms end subroutine interpolate_atoms
subroutine interpolate_vel(type, esize, lat_type, vel_in, vel_interp)
!This subroutine returns the interpolated atoms from the elements.
!Arguments
character(len=*), intent(in) :: type !The type of element that it is
integer, intent(in) :: esize !The number of atoms per side
integer, intent(in) :: lat_type !The integer lattice type of the element
real(kind=dp), dimension(:,:,:), intent(in) :: vel_in !Nodal positions
real(kind=dp), dimension(3, max_basisnum*max_esize**3), intent(out) :: vel_interp !Interpolated atomic positions
!Internal variables
integer :: it, is, ir, ibasis, inod, ia, bnum, lat_type_temp, adjust
real(kind=dp) :: a_shape(max_ng_node)
real(kind=dp) :: t, s, r
!Initialize some variables
vel_interp(:,:) = 0.0_dp
ia = 0
!Define bnum based on the input lattice type. If lat_type=0 then we are interpolating lattice points which means
!the basis is 0,0,0, and the type doesn't matter
select case(lat_type)
case(0)
bnum=1
lat_type_temp = 1
case default
bnum = basisnum(lat_type)
lat_type_temp = lat_type
end select
select case(type)
case('fcc','bcc')
!Now loop over all the possible sites
do it = 1, esize
t=-1.0_dp +(it-1)*(2.0_dp/(esize-1))
do is =1, esize
s=-1.0_dp +(is-1)*(2.0_dp/(esize-1))
do ir = 1, esize
r=-1.0_dp +(ir-1)*(2.0_dp/(esize-1))
call rhombshape(r,s,t,a_shape)
do ibasis = 1, bnum
ia = ia + 1
do inod = 1, 8
vel_interp(:,ia) = vel_interp(:,ia) + a_shape(inod) * vel_in(:,ibasis,inod)
end do
end do
end do
end do
end do
end select
if (ia /= bnum*esize**3) then
print *, "Incorrect interpolation"
stop 3
end if
return
end subroutine interpolate_vel
subroutine rhombshape(r,s,t, shape_fun) subroutine rhombshape(r,s,t, shape_fun)
!Shape function for rhombohedral elements !Shape function for rhombohedral elements
real(kind=8), intent(in) :: r, s, t real(kind=8), intent(in) :: r, s, t
@ -661,6 +723,7 @@ module elements
end do end do
end subroutine wrap_atoms end subroutine wrap_atoms
subroutine wrap_elements subroutine wrap_elements
integer :: i, inod, ibasis, j, node_in_bd(3,max_ng_node) integer :: i, inod, ibasis, j, node_in_bd(3,max_ng_node)
real(kind =dp) :: box_len(3) real(kind =dp) :: box_len(3)
@ -1018,11 +1081,36 @@ do i = 1, atom_num
subroutine add_atom_data(ia, eng, force, virial) subroutine add_atom_data(ia, eng, force, virial)
!Function which sets the atom data arrays !Function which sets the atom data arrays
integer, intent(in) :: ia integer, intent(in) :: ia
real(kind=dp), intent(in) :: eng, force(3), virial(6) real(kind=dp), intent(in) :: eng, force(:), virial(:)
integer :: size_atom_array
real(kind=dp), allocatable :: tmp_eng(:), tmp_force(:,:), tmp_virial(:,:)
size_atom_array=size(tag_atom)
if(ia > atom_num) then
stop "ia in add_atom_dat shouldn't be larger than atom_num"
else if(ia > size(energy_atom)) then
allocate(tmp_eng(size(energy_atom)+1024))
allocate(tmp_force(3, size(energy_atom)+1024))
allocate(tmp_virial(6, size(energy_atom)+1024))
tmp_eng=0.0_dp
tmp_eng(1:size(energy_atom)) = energy_atom
call move_alloc(tmp_eng, energy_atom)
tmp_force=0.0_dp
tmp_force(:, 1:size(force_atom, 2)) = force_atom
call move_alloc(tmp_force, force_atom)
tmp_virial=0.0_dp
tmp_virial(:, 1:size(virial_atom,2)) = virial_atom
call move_alloc(tmp_virial, virial_atom)
end if
energy_atom(ia) = eng energy_atom(ia) = eng
force_atom(:,ia) = force(:) force_atom(:,ia) = force(:)
virial_atom(:,ia) = virial(:) virial_atom(:,ia) = virial(:)
vflag = .true. vflag = .true.
return return
end subroutine add_atom_data end subroutine add_atom_data

4
src/functions.f90
View File

@ -168,11 +168,11 @@ END FUNCTION StrDnCase
do i =1 ,3 do i =1 ,3
!Check upper bound !Check upper bound
if(v(i) > (box_bd(2*i)+10.0_dp**(-10)) ) then if(v(i) > (box_bd(2*i))) then
in_block_bd =.false. in_block_bd =.false.
exit exit
!Check lower bound !Check lower bound
else if (v(i) < (box_bd(2*i-1)-10.0_dp**(-10))) then else if (v(i) < (box_bd(2*i-1))+1d-6) then
in_block_bd = .false. in_block_bd = .false.
exit exit
end if end if

28
src/io.f90
View File

@ -139,7 +139,7 @@ module io
do i = 1, ele_num do i = 1, ele_num
do inod = 1, ng_node(lat_ele(i)) do inod = 1, ng_node(lat_ele(i))
do ibasis = 1, basisnum(lat_ele(i)) do ibasis = 1, basisnum(lat_ele(i))
write(11, '(2i16, 3f23.15)') basis_type(ibasis,lat_ele(i)), 1, r_node(:,ibasis,inod,i) write(11, *) basis_type(ibasis,lat_ele(i)), 1, r_node(:,ibasis,inod,i)
outn = outn + 1 outn = outn + 1
end do end do
end do end do
@ -151,7 +151,7 @@ module io
!Write atom positions !Write atom positions
do i = 1, atom_num do i = 1, atom_num
write(11, '(2i16, 3f23.15)') type_atom(i), 0, r_atom(:,i) write(11, *) type_atom(i), 0, r_atom(:,i)
outn = outn + 1 outn = outn + 1
end do end do
@ -207,7 +207,7 @@ module io
write(11, '(a)') 'Atoms' write(11, '(a)') 'Atoms'
write(11, '(a)') ' ' write(11, '(a)') ' '
do i = 1, atom_num do i = 1, atom_num
write(11, '(2i16, 3f23.15)') tag_atom(i), type_atom(i), r_atom(:,i) write(11, *) tag_atom(i), type_atom(i), r_atom(:,i)
end do end do
!Write refined element atomic positions !Write refined element atomic positions
@ -219,7 +219,7 @@ module io
do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3 do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3
interp_num = interp_num+1 interp_num = interp_num+1
call apply_periodic(r_interp(:,iatom)) call apply_periodic(r_interp(:,iatom))
write(11, '(2i16, 3f23.15)') atom_num+interp_num, type_interp(iatom), r_interp(:,iatom) write(11, *) atom_num+interp_num, type_interp(iatom), r_interp(:,iatom)
end do end do
end select end select
end do end do
@ -277,12 +277,12 @@ module io
if (write_dat) then if (write_dat) then
do i = 1, atom_num do i = 1, atom_num
write(11, '(2i16, 13f23.15)') tag_atom(i), type_atom(i), r_atom(:,i), energy_atom(i), & write(11, *) tag_atom(i), type_atom(i), r_atom(:,i), energy_atom(i), &
force_atom(:,i), virial_atom(:,i) force_atom(:,i), virial_atom(:,i)
end do end do
else else
do i = 1, atom_num do i = 1, atom_num
write(11, '(2i16, 3f23.15)') tag_atom(i), type_atom(i), r_atom(:,i) write(11, *) tag_atom(i), type_atom(i), r_atom(:,i)
end do end do
end if end if
@ -294,12 +294,12 @@ module io
do inod =1, ng_node(lat_ele(i)) do inod =1, ng_node(lat_ele(i))
do ibasis=1, basisnum(lat_ele(i)) do ibasis=1, basisnum(lat_ele(i))
if(write_dat) then if(write_dat) then
write(11, '(2i16, 13f23.15)') atom_num+interp_num, basis_type(ibasis,lat_ele(i)), & write(11, *) atom_num+interp_num, basis_type(ibasis,lat_ele(i)), &
r_node(:, ibasis, inod, i), energy_node(ibasis,inod,i), force_node(:, ibasis, inod, i), & r_node(:, ibasis, inod, i), energy_node(ibasis,inod,i), force_node(:, ibasis, inod, i), &
virial_node(:, ibasis, inod, i) virial_node(:, ibasis, inod, i)
else else
write(11, '(2i16, 3f23.15)') atom_num+interp_num, basis_type(ibasis,lat_ele(i)), & write(11, *) atom_num+interp_num, basis_type(ibasis,lat_ele(i)), &
r_node(:, ibasis, inod, i) r_node(:, ibasis, inod, i)
end if end if
interp_num = interp_num +1 interp_num = interp_num +1
@ -321,14 +321,14 @@ module io
do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3 do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3
interp_num = interp_num+1 interp_num = interp_num+1
call apply_periodic(r_interp(:,iatom)) call apply_periodic(r_interp(:,iatom))
write(11, '(2i16, 13f23.15)') atom_num+interp_num, type_interp(iatom), r_interp(:,iatom), & write(11, *) atom_num+interp_num, type_interp(iatom), r_interp(:,iatom), &
data_interp(:,iatom) data_interp(:,iatom)
end do end do
else else
do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3 do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3
interp_num = interp_num+1 interp_num = interp_num+1
call apply_periodic(r_interp(:,iatom)) call apply_periodic(r_interp(:,iatom))
write(11, '(2i16, 3f23.15)') atom_num+interp_num, type_interp(iatom), r_interp(:,iatom) write(11, *) atom_num+interp_num, type_interp(iatom), r_interp(:,iatom)
end do end do
end if end if
end select end select
@ -998,7 +998,7 @@ module io
!Internal Variables !Internal Variables
integer :: i, j, in_eles, in_atoms, inbtypes(10), lat_type, ia, ie, inod, & integer :: i, j, in_eles, in_atoms, inbtypes(10), lat_type, ia, ie, inod, &
id, type_node, ilat, esize, tag, type, bnum, n, ibasis, ip, atom_type_map(100) id, type_node, ilat, esize, tag, atype, bnum, n, ibasis, ip, atom_type_map(100)
real(kind=dp) :: newdisplace(3), ra(3), in_lapa, ea, fa(3), va(6), vela(3),& real(kind=dp) :: newdisplace(3), ra(3), in_lapa, ea, fa(3), va(6), vela(3),&
ee(10,20), fe(3,10,20), ve(6,10,20), re(3,10,20), vele(3,10,20), atomic_masses(10) ee(10,20), fe(3,10,20), ve(6,10,20), re(3,10,20), vele(3,10,20), atomic_masses(10)
character(len=100) :: textholder, fcc character(len=100) :: textholder, fcc
@ -1064,11 +1064,11 @@ module io
do ia = 1, in_atoms do ia = 1, in_atoms
read(11,'(a)') line(:) read(11,'(a)') line(:)
if(read_vel) then if(read_vel) then
read(line,*) tag, type, ra(:), ea, fa(:), va(:), vela(:) read(line,*) tag, atype, ra(:), ea, fa(:), va(:), vela(:)
else else
read(line,*) tag, type, ra(:), ea, fa(:), va(:) read(line,*) tag, atype, ra(:), ea, fa(:), va(:)
end if end if
call add_atom(tag, atom_type_map(type), ra) call add_atom(tag, atom_type_map(atype), ra)
call add_atom_data(atom_num, ea, fa, va) call add_atom_data(atom_num, ea, fa, va)
if(read_vel) vel_atom(:,atom_num) = vela if(read_vel) vel_atom(:,atom_num) = vela
end do end do

26
src/mode_calc.f90
View File

@ -25,6 +25,9 @@ module mode_calc
case('tot_virial') case('tot_virial')
allocate(calculated(6)) allocate(calculated(6))
call calc_tot_virial call calc_tot_virial
case('tot_energy')
allocate(calculated(1))
call calc_tot_energy
case default case default
print *, trim(adjustl(calc_opt)), " is not accepted as a calc option in mode_calc" print *, trim(adjustl(calc_opt)), " is not accepted as a calc option in mode_calc"
stop 3 stop 3
@ -87,5 +90,26 @@ module mode_calc
print *, "Total virial is calculated as : (v11, v22, v33, v32, v31, v21)" print *, "Total virial is calculated as : (v11, v22, v33, v32, v31, v21)"
print *, calculated print *, calculated
end subroutine end subroutine calc_tot_virial
subroutine calc_tot_energy
integer :: i, inod, ibasis, j
calculated=0
!Sum atom energies
do i = 1, atom_num
calculated(1) = calculated(1) + energy_atom(i)
end do
!Sum element energies
do i =1, ele_num
do inod=1, ng_node(lat_ele(i))
do ibasis=1, basisnum(lat_ele(i))
calculated(1) = calculated(1) + energy_node(ibasis, inod, i)*(size_ele(i)**3)/ng_node(lat_ele(i))
end do
end do
end do
print *, 'Total energy in eV is:'
print *, calculated(1)
end subroutine calc_tot_energy
end module mode_calc end module mode_calc

4
src/mode_create.f90
View File

@ -12,9 +12,9 @@ module mode_create
character(len=100) :: name, element_type character(len=100) :: name, element_type
real(kind = dp) :: lattice_parameter, orient(3,3), cell_mat(3,8), box_len(3), basis(3,3), origin(3), maxlen(3), & real(kind = dp) :: lattice_parameter, orient(3,3), cell_mat(3,8), box_len(3), basis(3,3), origin(3), maxlen(3), &
orient_inv(3,3), box_vert(3,8), maxbd(3), lattice_space(3), duplicate(3) orient_inv(3,3), box_vert(3,8), maxbd(3), lattice_space(3), duplicate(3), basis_pos(3,10)
integer :: esize, ix, iy, iz, box_lat_vert(3,8), lat_ele_num, lat_atom_num, bd_in_lat(6), & integer :: esize, ix, iy, iz, box_lat_vert(3,8), lat_ele_num, lat_atom_num, bd_in_lat(6), &
basis_pos(3,10), esize_nums, esize_index(10) esize_nums, esize_index(10)
logical :: dup_flag, dim_flag, efill, crossb(3) logical :: dup_flag, dim_flag, efill, crossb(3)
real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:) real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:)

4
src/neighbors.f90
View File

@ -82,7 +82,7 @@ module neighbors
real(kind=dp), intent(in) :: rc_off real(kind=dp), intent(in) :: rc_off
integer, intent(in) :: n integer, intent(in) :: n
real(kind=dp), dimension(3,n) :: r_list real(kind=dp), dimension(:, :), intent(in) :: r_list
integer :: i, j, c(3),cn(3), ci, cj, ck, num_nei, nei, v(3), period_dir(3) integer :: i, j, c(3),cn(3), ci, cj, ck, num_nei, nei, v(3), period_dir(3)
!Variables for cell list code !Variables for cell list code
@ -92,7 +92,7 @@ module neighbors
real(kind=dp) :: r(3), box_len(3) real(kind=dp) :: r(3), box_len(3)
logical :: period_bd(3) logical :: period_bd(3)
!First reallocate the neighbor list codes !First reallocate the neighbor list variables
if (allocated(nei_list)) then if (allocated(nei_list)) then
deallocate(nei_list,nei_num, periodvec) deallocate(nei_list,nei_num, periodvec)
end if end if

30
src/opt_bubble.f90
View File

@ -32,7 +32,7 @@ module opt_bubble
type='all' type='all'
gshape='sphere' gshape='sphere'
group_nodes = .true. group_nodes = .true.
group_atom_types=0
call get_group call get_group
call refine_group call refine_group
call get_group call get_group
@ -80,6 +80,7 @@ module opt_bubble
integer, intent(inout) :: arg_pos integer, intent(inout) :: arg_pos
integer :: i, arglen integer :: i, arglen
real(kind=dp) :: mass
character(len=100) :: tmptxt character(len=100) :: tmptxt
@ -111,7 +112,34 @@ module opt_bubble
print *, species print *, species
if(arglen == 0) stop "Missing bubble species" if(arglen == 0) stop "Missing bubble species"
!OPtional arguments
do while(.true.)
if(arg_pos > command_argument_count()) exit
arg_pos=arg_pos+1 arg_pos=arg_pos+1
call get_command_argument(arg_pos, tmptxt)
tmptxt=adjustl(tmptxt)
select case(trim(tmptxt))
case('excludetypes')
arg_pos=arg_pos + 1
call get_command_argument(arg_pos, tmptxt, arglen)
if(arglen==0) stop "Missing number of atoms to exclude"
read(tmptxt, *) exclude_num
do i=1,exclude_num
arg_pos = arg_pos + 1
call get_command_argument(arg_pos, tmptxt, arglen)
if(arglen==0) stop "Missing exclude atom types"
call atommass(tmptxt, mass)
call add_atom_type(mass, exclude_types(i))
end do
case default
exit
end select
end do
return return
end subroutine parse_bubble end subroutine parse_bubble
end module opt_bubble end module opt_bubble

2
src/opt_delete.f90
View File

@ -87,7 +87,7 @@ module opt_delete
allocate(which_cell(3,atom_num)) allocate(which_cell(3,atom_num))
!First pass the atom list and atom num to the algorithm which builds the cell list !First pass the atom list and atom num to the algorithm which builds the cell list
call build_cell_list(atom_num, r_atom, rc_off, cell_num, num_in_cell, cell_list, which_cell) call build_cell_list(atom_num, r_atom, 5*rc_off, cell_num, num_in_cell, cell_list, which_cell)
!Now loop over every atom and figure out if it has neighbors within the rc_off !Now loop over every atom and figure out if it has neighbors within the rc_off
delete_num = 0 delete_num = 0

2
src/opt_disl.f90
View File

@ -520,7 +520,7 @@ module opt_disl
end do end do
return return
end subroutine end subroutine disloop
!******************************************************** !********************************************************
! SOLIDANGLE ! SOLIDANGLE

227
src/opt_group.f90
View File

@ -12,7 +12,7 @@ module opt_group
implicit none implicit none
integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num, group_type, notsize, insert_type, & integer :: group_ele_num, group_atom_num, remesh_size,normal, dim1, dim2, random_num, group_type, notsize, insert_type, &
insert_site, num_species insert_site, num_species, group_atom_types, exclude_num, exclude_types(10)
character(len=15) :: type, gshape!Type indicates what element type is selected and shape is the group shape character(len=15) :: type, gshape!Type indicates what element type is selected and shape is the group shape
character(len=2) :: species_type(10) character(len=2) :: species_type(10)
real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), radius, bwidth, shell_thickness, insert_conc, & real(kind=dp) :: block_bd(6), centroid(3), vertices(3,3),disp_vec(3), radius, bwidth, shell_thickness, insert_conc, &
@ -39,6 +39,7 @@ module opt_group
insert_type = 0 insert_type = 0
random_num=0 random_num=0
group_type=0 group_type=0
group_atom_types=0
notsize=0 notsize=0
displace=.false. displace=.false.
delete=.false. delete=.false.
@ -47,6 +48,7 @@ module opt_group
flip = .false. flip = .false.
group_nodes=.false. group_nodes=.false.
num_species = 0 num_species = 0
exclude_num = 0
if(allocated(element_index)) deallocate(element_index) if(allocated(element_index)) deallocate(element_index)
if(allocated(atom_index)) deallocate(atom_index) if(allocated(atom_index)) deallocate(atom_index)
@ -87,10 +89,10 @@ module opt_group
call displace_group call displace_group
end if end if
if(insert_type > 0) then if(insert_type > 0) then
print *, "Insert command has been dropped" !print *, "Insert command has been dropped"
stop 1 !stop 1
call get_group call get_group
! call insert_group call insert_group
end if end if
if(num_species > 0) then if(num_species > 0) then
@ -470,6 +472,24 @@ module opt_group
refine=.true. refine=.true.
case('refinefill') case('refinefill')
refinefill=.true. refinefill=.true.
case('selecttype')
arg_pos = arg_pos + 1
call get_command_argument(arg_pos, textholder, arglen)
if (arglen==0) stop "Missing select type"
call atommass(textholder, mass)
call add_atom_type(mass, group_atom_types)
case('excludetypes')
arg_pos=arg_pos + 1
call get_command_argument(arg_pos, textholder, arglen)
if(arglen==0) stop "Missing number of atoms to exclude"
read(textholder, *) exclude_num
do i=1,exclude_num
arg_pos = arg_pos + 1
call get_command_argument(arg_pos, textholder, arglen)
if(arglen==0) stop "Missing exclude atom types"
call atommass(textholder, mass)
call add_atom_type(mass, exclude_types(i))
end do
case('remesh') case('remesh')
arg_pos = arg_pos + 1 arg_pos = arg_pos + 1
call get_command_argument(arg_pos, textholder, arglen) call get_command_argument(arg_pos, textholder, arglen)
@ -619,7 +639,7 @@ module opt_group
select case(trim(adjustl(type))) select case(trim(adjustl(type)))
case('atoms','all') case('atoms','all')
do i = 1, atom_num do i = 1, atom_num
if(in_group(r_atom(:,i)).neqv.flip) then if(in_group(type_atom(i), r_atom(:,i)).neqv.flip) then
group_atom_num = group_atom_num + 1 group_atom_num = group_atom_num + 1
if (group_atom_num > size(atom_index)) then if (group_atom_num > size(atom_index)) then
allocate(resize_array(size(atom_index) + 1024)) allocate(resize_array(size(atom_index) + 1024))
@ -687,8 +707,19 @@ module opt_group
!This command is used to refine the group to full atomistics !This command is used to refine the group to full atomistics
integer :: i, j, ie, type_interp(max_basisnum*max_esize**3), add_atom_num, orig_atom_num integer :: i, j, ie, type_interp(max_basisnum*max_esize**3), add_atom_num, orig_atom_num
real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3) real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), data_interp(10, max_basisnum*max_esize**3), &
vel_interp(3, max_basisnum*max_esize**3)
real(kind=dp), allocatable :: vel_tmp(:,:)
logical :: refine_dat
if (allocated(force_node)) then
refine_dat=.true.
else
refine_dat=.false.
end if
print *, size(data_interp)
!Refining to atoms !Refining to atoms
if(group_ele_num > 0) then if(group_ele_num > 0) then
orig_atom_num = atom_num orig_atom_num = atom_num
@ -698,17 +729,38 @@ module opt_group
do i = 1, group_ele_num do i = 1, group_ele_num
ie = element_index(i) ie = element_index(i)
!Get the interpolated atom positions !Get the interpolated atom positions
if (refine_dat) then
call interpolate_atoms(type_ele(i), size_ele(i), lat_ele(i), r_node(:,:,:,i), type_interp, r_interp, &
energy_node(:,:,i), force_node(:,:,:,i), virial_node(:,:,:,i), data_interp)
else
call interpolate_atoms(type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie), type_interp, r_interp) call interpolate_atoms(type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie), type_interp, r_interp)
end if
if(allocated(vel_atom)) then
call interpolate_vel(type_ele(i), size_ele(i), lat_ele(i), vel_node(:,:,:,i), vel_interp)
end if
!Loop over all interpolated atoms and add them to the system, we apply periodic boundaries !Loop over all interpolated atoms and add them to the system, we apply periodic boundaries
!here as well to make sure they are in the box !here as well to make sure they are in the box
do j = 1, basisnum(lat_ele(ie))*size_ele(ie)**3 do j = 1, basisnum(lat_ele(ie))*size_ele(ie)**3
call apply_periodic(r_interp(:,j)) call apply_periodic(r_interp(:,j))
call add_atom(0,type_interp(j), r_interp(:,j)) call add_atom(0,type_interp(j), r_interp(:,j))
if(refine_dat) then
call add_atom_data(atom_num, data_interp(1, j), data_interp(2:4, j), data_interp(5:10, j))
end if
if(allocated(vel_atom)) then
if(size(vel_atom, 2) < size(type_atom)) then
allocate(vel_tmp(3, size(type_atom)))
vel_tmp=0.0_dp
vel_tmp(:, 1:size(vel_atom,2)) = vel_atom
call move_alloc(vel_tmp, vel_atom)
end if
vel_atom(:, atom_num) = vel_interp(:,j)
end if
end do end do
end do end do
!Once all atoms are added we delete all of the elements !Once all atoms are added we delete all of the elements
call delete_elements(group_ele_num, element_index) call delete_elements(group_ele_num, element_index)
print *, group_ele_num, " elements of group are refined to ", atom_num -orig_atom_num, " atoms." print *, group_ele_num, " elements of group are refined to ", atom_num -orig_atom_num, " atoms."
end if end if
end subroutine refine_group end subroutine refine_group
@ -745,7 +797,7 @@ module opt_group
ravg = ravg + rfill(:,ibasis, 1)/basisnum(lat_ele(ie)) ravg = ravg + rfill(:,ibasis, 1)/basisnum(lat_ele(ie))
end do end do
if( in_group(ravg)) then if( in_group(0,ravg)) then
nump_ele = nump_ele - 1 nump_ele = nump_ele - 1
end if end if
end do end do
@ -1118,77 +1170,79 @@ module opt_group
end subroutine change_group_type end subroutine change_group_type
! subroutine insert_group subroutine insert_group
! !This code inserts atoms into interstitial sites. This only works on atoms within the group due to the limitations with the !This code inserts atoms into interstitial sites. This only works on atoms within the group due to the limitations with the
! !Coarse-graining methodology which doesn't allow for concentration fluctuations. !Coarse-graining methodology which doesn't allow for concentration fluctuations.
! real(kind=dp) interstitial_sites(3,14), rand, rinsert(3) real(kind=dp) interstitial_sites(3,14), rand, rinsert(3)
! integer :: add_num, i, j, rindex, sindex, ia, rlo, rhi integer :: add_num, i, j, rindex, sindex, ia, rlo, rhi
! integer, allocatable :: used_sites(:,:) integer, allocatable :: used_sites(:,:)
!
! !First save all of the displacement vectors from a lattice site to interstitial site !First save all of the displacement vectors from a lattice site to interstitial site
! !The first 6 are the octohedral sites and the next 8 are the tetrahedral sites !The first 6 are the octohedral sites and the next 8 are the tetrahedral sites
! interstitial_sites= reshape( (/ -0.5_dp, 0.0_dp, 0.0_dp, & interstitial_sites= reshape( (/ -0.5_dp, 0.0_dp, 0.0_dp, &
! 0.5_dp, 0.0_dp, 0.0_dp, & 0.5_dp, 0.0_dp, 0.0_dp, &
! 0.0_dp,-0.5_dp, 0.0_dp, & 0.0_dp,-0.5_dp, 0.0_dp, &
! 0.0_dp, 0.5_dp, 0.0_dp, & 0.0_dp, 0.5_dp, 0.0_dp, &
! 0.0_dp, 0.0_dp,-0.5_dp, & 0.0_dp, 0.0_dp,-0.5_dp, &
! 0.0_dp, 0.0_dp, 0.5_dp, & 0.0_dp, 0.0_dp, 0.5_dp, &
! -0.25_dp,-0.25_dp,-0.25_dp, & -0.25_dp,-0.25_dp,-0.25_dp, &
! -0.25_dp,-0.25_dp, 0.25_dp, & -0.25_dp,-0.25_dp, 0.25_dp, &
! -0.25_dp, 0.25_dp,-0.25_dp, & -0.25_dp, 0.25_dp,-0.25_dp, &
! -0.25_dp, 0.25_dp, 0.25_dp, & -0.25_dp, 0.25_dp, 0.25_dp, &
! 0.25_dp,-0.25_dp,-0.25_dp, & 0.25_dp,-0.25_dp,-0.25_dp, &
! 0.25_dp,-0.25_dp, 0.25_dp, & 0.25_dp,-0.25_dp, 0.25_dp, &
! 0.25_dp, 0.25_dp,-0.25_dp, & 0.25_dp, 0.25_dp,-0.25_dp, &
! 0.25_dp, 0.25_dp, 0.25_dp /), & 0.25_dp, 0.25_dp, 0.25_dp /), &
! shape(interstitial_sites)) shape(interstitial_sites))
!
! !First we calculate the number of atoms needed based on the number of atoms in the group and the concentration !First we calculate the number of atoms needed based on the number of atoms in the group and the concentration
! interstitial_sites=interstitial_sites*insert_lattice interstitial_sites=interstitial_sites*insert_lattice
!
! add_num = (insert_conc*group_atom_num)/(1-insert_conc)
! allocate(used_sites(2,add_num)) !Now set up the random number generator for the desired interstitial type
! select case(insert_site)
! print *, "Inserting ", add_num, " atoms as atom type ", insert_type case(1)
! rlo=1
! !Now set up the random number generator for the desired interstitial type rhi=6
! select case(insert_site) case(2)
! case(1) rlo=7
! rlo=1 rhi = 14
! rhi=6 case(3)
! case(2) rlo=1
! rlo=7 rhi=14
! rhi = 14 end select
! case(3)
! rlo=1 if ((insert_conc > 1).or.(insert_conc < 0)) stop "Insert concentration should be between 0 and 1"
! rhi=14 add_num = (insert_conc*group_atom_num)
! end select allocate(used_sites(2,add_num))
!
! !Now add the atoms print *, "Inserting ", add_num, " atoms as atom type ", insert_type
! i = 1
! addloop:do while ( i < add_num) !Now add the atoms
! call random_number(rand) i = 1
! rindex = int(1+rand*(group_atom_num-1)) addloop:do while ( i < add_num)
! ia=atom_index(rindex) call random_number(rand)
! call random_number(rand) rindex = int(1+rand*(group_atom_num-1))
! sindex = int(rlo+rand*(rhi-rlo)) ia=atom_index(rindex)
! do j = 1, i call random_number(rand)
! if((ia == used_sites(1,i)).and.(sindex == used_sites(2,i))) cycle addloop sindex = int(rlo+rand*(rhi-rlo))
! end do do j = 1, i
! rinsert = r_atom(:,ia) + matmul(sub_box_ori(:,:,sbox_atom(ia)),interstitial_sites(:,sindex)) if((ia == used_sites(1,i)).and.(sindex == used_sites(2,i))) cycle addloop
! sbox = sbox_atom(ia) end do
! call add_atom(0, insert_type, sbox, rinsert) rinsert = r_atom(:,ia) + matmul(box_ori,interstitial_sites(:,sindex))
! used_sites(1,i) = ia call add_atom(0, insert_type, rinsert)
! used_sites(2,i) = sindex used_sites(1,i) = ia
! i = i + 1 used_sites(2,i) = sindex
! end do addloop i = i + 1
! end subroutine insert_group end do addloop
end subroutine insert_group
subroutine alloy_group subroutine alloy_group
!This subroutine randomizes the atom types to reach desired concentrations, this only operates on atoms !This subroutine randomizes the atom types to reach desired concentrations, this only operates on atoms
integer :: i, j, ia, type_map(10), added_types(num_species) integer :: i, j, ia, type_map(10), added_types(num_species)
real(kind=dp) :: rand, mass, old_fractions(num_species) real(kind=dp) :: rand, mass, old_fractions(num_species)
character(len=2) :: sorted_species_type(10) character(len=2) :: sorted_species_type(10)
logical :: species_mapped(10)
print *, "Alloying group with desired fractions", s_fractions(1:num_species) print *, "Alloying group with desired fractions", s_fractions(1:num_species)
@ -1196,10 +1250,13 @@ module opt_group
!First we sort the fractions !First we sort the fractions
call quicksort(s_fractions(1:num_species)) call quicksort(s_fractions(1:num_species))
species_mapped = .false.
do i = 1,num_species do i = 1,num_species
do j=1, num_species do j=1, num_species
if (is_equal(s_fractions(i), old_fractions(j))) then if (is_equal(s_fractions(i), old_fractions(j)) .and. .not. species_mapped(j)) then
sorted_species_type(i)=species_type(j) sorted_species_type(i)=species_type(j)
species_mapped(j) = .true.
exit
end if end if
end do end do
end do end do
@ -1230,8 +1287,9 @@ module opt_group
return return
end subroutine alloy_group end subroutine alloy_group
function in_group(r) function in_group(atype, r)
!This subroutine determines if a point is within the group boundaries !This subroutine determines if a point is within the group boundaries
integer, intent(in) :: atype
real(kind=dp), intent(in) :: r(3) real(kind=dp), intent(in) :: r(3)
real(kind=dp) :: rnorm real(kind=dp) :: rnorm
@ -1276,6 +1334,19 @@ module opt_group
case('all') case('all')
in_group = .true. in_group = .true.
end select end select
if(group_atom_types> 0) then
in_group = in_group.and.(atype== group_atom_types)
elseif(exclude_num > 0) then
if(in_group) then
do i=1,exclude_num
if (atype == exclude_types(i)) then
in_group=.false.
exit
end if
end do
end if
end if
end function in_group end function in_group
function in_group_ele(esize, elat, rn) function in_group_ele(esize, elat, rn)
@ -1299,13 +1370,13 @@ module opt_group
r_center(:)= r_center(:) + rn(:,ibasis,inod)/basisnum(elat) r_center(:)= r_center(:) + rn(:,ibasis,inod)/basisnum(elat)
end do end do
if((in_group(rn(:, ibasis, inod)).neqv.flip).and.(size_ele(i)/=notsize)) then if((in_group(0,rn(:, ibasis, inod)).neqv.flip).and.(size_ele(i)/=notsize)) then
node_in_out(inod) = 2 node_in_out(inod) = 2
exit nodeloop exit nodeloop
end if end if
gshape ='sphere' gshape ='sphere'
if((in_group(rn(:, ibasis, inod)).neqv.flip).and.(esize/=notsize)) then if((in_group(0,rn(:, ibasis, inod)).neqv.flip).and.(esize/=notsize)) then
node_in_out(inod) = 1 node_in_out(inod) = 1
else else
node_in_out(inod) = 0 node_in_out(inod) = 0
@ -1327,7 +1398,7 @@ module opt_group
end do end do
end do end do
if ((in_group(r_center).neqv.flip).and.(esize/= notsize)) then if ((in_group(0,r_center).neqv.flip).and.(esize/= notsize)) then
in_group_ele=.true. in_group_ele=.true.
return return
end if end if
@ -1336,7 +1407,7 @@ module opt_group
r_center(:) = 0.0_dp r_center(:) = 0.0_dp
do inod = 1, ng_node(elat) do inod = 1, ng_node(elat)
do ibasis = 1, basisnum(elat) do ibasis = 1, basisnum(elat)
if ((in_group(rn(:,ibasis,inod)).neqv.flip).and.(esize/=notsize)) then if ((in_group(0,rn(:,ibasis,inod)).neqv.flip).and.(esize/=notsize)) then
in_group_ele=.true. in_group_ele=.true.
return return
end if end if

20
src/opt_slip_plane.f90
View File

@ -17,11 +17,13 @@ module opt_slip_plane
!Main calling function for the slip_plane option !Main calling function for the slip_plane option
integer, intent(inout) :: arg_pos integer, intent(inout) :: arg_pos
integer :: ie, ia, slip_enum, old_atom_num, esize, new_ele_num, n, m, o, ele(3,8), nump_ele, inod, vlat(3), ibasis integer :: ie, ia, slip_enum, old_atom_num, esize, new_ele_num, n, m, o, ele(3,8), nump_ele, inod, vlat(3), ibasis,&
starting_anum
integer, allocatable :: slip_eles(:), temp_int(:) integer, allocatable :: slip_eles(:), temp_int(:)
real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum, max_ng_node), ratom(3,max_basisnum), & real(kind=dp) :: r_interp(3, max_basisnum*max_esize**3), rfill(3,max_basisnum, max_ng_node), ratom(3,max_basisnum), &
maxp, minp maxp, minp, vel_interp(3, max_basisnum*max_esize**3)
real(kind=dp), allocatable :: vel_tmp(:,:)
integer :: type_interp(max_basisnum*max_esize**3) integer :: type_interp(max_basisnum*max_esize**3)
logical :: lat_points(max_esize,max_esize, max_esize) logical :: lat_points(max_esize,max_esize, max_esize)
@ -58,11 +60,25 @@ module opt_slip_plane
!If we aren't efilling then just refine the element !If we aren't efilling then just refine the element
if(.not.efill) then if(.not.efill) then
starting_anum=atom_num
call interpolate_atoms(type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie), type_interp, r_interp) call interpolate_atoms(type_ele(ie), size_ele(ie), lat_ele(ie), r_node(:,:,:,ie), type_interp, r_interp)
do ia = 1, basisnum(lat_ele(ie)) * size_ele(ie)**3 do ia = 1, basisnum(lat_ele(ie)) * size_ele(ie)**3
call apply_periodic(r_interp(:,ia)) call apply_periodic(r_interp(:,ia))
call add_atom(0, type_interp(ia), r_interp(:,ia)) call add_atom(0, type_interp(ia), r_interp(:,ia))
end do end do
if(allocated(vel_atom)) then
call interpolate_vel(type_ele(ie), size_ele(ie), lat_ele(ie), vel_node(:,:,:,ie), vel_interp)
if(size(vel_atom,2) < size(type_atom)) then
allocate(vel_tmp(3, size(type_atom)))
vel_tmp=0.0_dp
vel_tmp(:, 1:size(vel_atom,2)) = vel_atom
call move_alloc(vel_tmp, vel_atom)
end if
do ia = 1, basisnum(lat_ele(ie)) * size_ele(ie)**3
vel_atom(:, starting_anum+ia) = vel_interp(:, ia)
end do
end if
!If we are efilling then the code is slightly more complex !If we are efilling then the code is slightly more complex
else else
!First populate the lat points array !First populate the lat points array