Lots of accumulated fixes to various functionality with cacmb
This commit is contained in:
Alex Selimov
parent
1114a46c60
commit
d9920bbef0
@ -143,6 +143,7 @@ module elements
|
||||
|
||||
max_basisnum = 0
|
||||
basisnum(:) = 0
|
||||
basis_type(:,:) = 0
|
||||
ng_node(:) = 0
|
||||
node_num = 0
|
||||
node_atoms = 0
|
||||
@ -308,7 +309,7 @@ module elements
|
||||
!Subroutine which adds an element to the element arrays
|
||||
integer, intent(in) :: size, lat, sbox, tag
|
||||
character(len=100), intent(in) :: type
|
||||
real(kind=dp), intent(in) :: r(3, max_basisnum, max_ng_node)
|
||||
real(kind=dp), intent(in) :: r(:,:,:)
|
||||
|
||||
integer :: newtag
|
||||
|
||||
@ -435,8 +436,8 @@ module elements
|
||||
real(kind=dp), dimension(:,:,:), intent(in) :: r_in !Nodal positions
|
||||
integer, dimension(:), intent(out) :: type_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(max_basisnum, max_ng_node), f(3, max_basisnum, max_ng_node), &
|
||||
v(6, max_basisnum, max_ng_node)
|
||||
real(kind = dp), optional, intent(in) :: eng(:,:), f(:,:,:), &
|
||||
v(:,:,:)
|
||||
real(kind=dp), dimension(10, max_basisnum*max_esize**3), optional,intent(out) :: data_interp !Interpolated atomic positions
|
||||
|
||||
!Internal variables
|
||||
@ -463,7 +464,7 @@ module elements
|
||||
end select
|
||||
|
||||
|
||||
select case(trim(adjustl(type)))
|
||||
select case(type)
|
||||
case('fcc','bcc')
|
||||
!Now loop over all the possible sites
|
||||
do it = 1, esize
|
||||
@ -657,11 +658,45 @@ module elements
|
||||
|
||||
subroutine wrap_atoms
|
||||
!This subroutine wraps atoms back into the simulation cell if they have exited for any reason
|
||||
|
||||
integer :: i
|
||||
do i = 1, atom_num
|
||||
call apply_periodic(r_atom(:,i))
|
||||
end do
|
||||
|
||||
end subroutine wrap_atoms
|
||||
subroutine wrap_elements
|
||||
integer :: i, inod, ibasis, j, node_in_bd(3,max_ng_node)
|
||||
real(kind =dp) :: box_len(3)
|
||||
|
||||
do j = 1, 3
|
||||
box_len(j) = box_bd(2*j) - box_bd(2*j-1)
|
||||
end do
|
||||
print *, box_bd
|
||||
do i = 1, ele_num
|
||||
node_in_bd = 0
|
||||
do inod = 1, ng_node(lat_ele(i))
|
||||
do ibasis = 1, basisnum(lat_ele(i))
|
||||
do j = 1, 3
|
||||
if(r_node(j,ibasis,inod,i) < box_bd(2*j-1)) then
|
||||
node_in_bd(j,inod) = 1
|
||||
else if(r_node(j,ibasis,inod,i) > box_bd(2*j)) then
|
||||
node_in_bd(j,inod) = -1
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do j = 1, 3
|
||||
if(all(node_in_bd(j,:) == 1)) then
|
||||
r_node(j,:,:,i) = r_node(j,:,:,i) + box_len(j)
|
||||
else if(all(node_in_bd(j,:) == -1)) then
|
||||
r_node(j,:,:,i) = r_node(j,:,:,i) - box_len(j)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end subroutine wrap_elements
|
||||
|
||||
|
||||
subroutine def_new_box
|
||||
!This subroutine calculates new box boundaries based on minimum and maximum nodal/atomic positions
|
||||
@ -1002,10 +1037,12 @@ do i = 1, atom_num
|
||||
real(kind=dp), intent(in) :: eng(max_basisnum, max_ng_node), &
|
||||
force(3,max_basisnum, max_ng_node), &
|
||||
virial(6,max_basisnum,max_ng_node)
|
||||
integer :: inod
|
||||
vflag = .true.
|
||||
energy_node(:,:,ie) = eng
|
||||
force_node(:,:,:,ie) = force
|
||||
virial_node(:,:,:,ie) = virial
|
||||
|
||||
return
|
||||
end subroutine add_element_data
|
||||
|
||||
|
||||
@ -275,11 +275,12 @@ module io
|
||||
|
||||
if (write_dat) then
|
||||
do i = 1, atom_num
|
||||
write(11, '(2i16, 13f23.15)') i, type_atom(i), r_atom(:,i), energy_atom(i), force_atom(:,i), virial_atom(:,i)
|
||||
write(11, '(2i16, 13f23.15)') tag_atom(i), type_atom(i), r_atom(:,i), energy_atom(i), &
|
||||
force_atom(:,i), virial_atom(:,i)
|
||||
end do
|
||||
else
|
||||
do i = 1, atom_num
|
||||
write(11, '(2i16, 3f23.15)') i, type_atom(i), r_atom(:,i)
|
||||
write(11, '(2i16, 3f23.15)') tag_atom(i), type_atom(i), r_atom(:,i)
|
||||
end do
|
||||
end if
|
||||
|
||||
@ -1146,6 +1147,7 @@ module io
|
||||
!Now set the nodes and basisnum
|
||||
max_ng_node = maxval(ng_node(1:lattice_types))
|
||||
max_basisnum = maxval(basisnum(1:lattice_types))
|
||||
|
||||
return
|
||||
end subroutine read_pycac_out
|
||||
|
||||
|
||||
@ -113,7 +113,10 @@ program main
|
||||
end do
|
||||
|
||||
!If wrap flag was passed then call the wrap atoms command
|
||||
if(wrap_flag) call wrap_atoms
|
||||
if(wrap_flag) then
|
||||
call wrap_atoms
|
||||
call wrap_elements
|
||||
end if
|
||||
|
||||
!If we called the boundary command then we adjust the box bounds
|
||||
if(bound_called) call def_new_box
|
||||
|
||||
@ -15,7 +15,7 @@ module mode_create
|
||||
orient_inv(3,3), box_vert(3,8), maxbd(3), lattice_space(3), duplicate(3)
|
||||
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)
|
||||
logical :: dup_flag, dim_flag, efill
|
||||
logical :: dup_flag, dim_flag, efill, crossb(3)
|
||||
|
||||
real(kind=dp), allocatable :: r_lat(:,:,:), r_atom_lat(:,:)
|
||||
integer, allocatable :: elat(:)
|
||||
@ -79,10 +79,10 @@ module mode_create
|
||||
do i = 1, 3
|
||||
box_bd(2*i) = maxval(box_vert(i,:)) - 0.25_dp*lattice_space(i)
|
||||
box_bd(2*i-1) = origin(i)-0.25_dp*lattice_space(i)
|
||||
box_len(i) = box_bd(2*i) - box_bd(2*i-1)
|
||||
end do
|
||||
|
||||
|
||||
|
||||
else if(dim_flag) then
|
||||
!As a note everything is defined so that the lattice parameter is multiplied in at the end
|
||||
!so we have to divide all the real Angstroms units by the lattice parameter
|
||||
@ -131,11 +131,11 @@ module mode_create
|
||||
!Call the build function with the correct transformation matrix
|
||||
select case(trim(adjustl(element_type)))
|
||||
case('fcc')
|
||||
call build_with_rhomb(box_lat_vert, fcc_mat, 8)
|
||||
call build_with_rhomb(box_lat_vert, fcc_mat, 8, fcc_inv)
|
||||
case('bcc')
|
||||
call build_with_rhomb(box_lat_vert, bcc_mat, 8)
|
||||
call build_with_rhomb(box_lat_vert, bcc_mat, 8, bcc_inv)
|
||||
case('20fcc')
|
||||
call build_with_rhomb(box_lat_vert, fcc_mat, 20)
|
||||
call build_with_rhomb(box_lat_vert, fcc_mat, 20, fcc_inv)
|
||||
case default
|
||||
print *, "Element type ", trim(adjustl(element_type)), " not accepted in mode create, please specify a supported ",&
|
||||
"element type"
|
||||
@ -176,6 +176,11 @@ module mode_create
|
||||
sub_box_num = 1
|
||||
sub_box_ori(:,:,1) = orient
|
||||
sub_box_bd(:,1) = box_bd
|
||||
|
||||
!If any elements are fully outside the box then wrap them back in
|
||||
if (any(crossb)) then
|
||||
call wrap_elements
|
||||
end if
|
||||
end subroutine create
|
||||
!This subroutine parses the command and pulls out information needed for mode_create
|
||||
subroutine parse_command(arg_pos)
|
||||
@ -183,9 +188,9 @@ module mode_create
|
||||
integer, intent(out) :: arg_pos
|
||||
integer :: ori_pos, i, j, arglen, stat
|
||||
character(len=100) :: textholder
|
||||
character(len=20) :: orient_string
|
||||
character(len=100) :: orient_string
|
||||
character(len=2) :: btype
|
||||
logical :: isortho, isrighthanded
|
||||
logical :: isortho, isrighthanded, bool
|
||||
|
||||
|
||||
!Pull out all required positional arguments
|
||||
@ -203,6 +208,7 @@ module mode_create
|
||||
call get_command_argument(5, textholder, arglen)
|
||||
if(arglen==0) STOP "Esize missing in mode create"
|
||||
read(textholder, *, iostat=stat) esize
|
||||
max_esize = esize
|
||||
if(stat > 0) STOP "Error reading esize"
|
||||
|
||||
arg_pos = 6
|
||||
@ -250,6 +256,12 @@ module mode_create
|
||||
read(textholder, *) origin(i)
|
||||
arg_pos = arg_pos + 1
|
||||
end do
|
||||
case('crossb')
|
||||
do i = 1, 3
|
||||
call get_command_argument(arg_pos, textholder)
|
||||
read(textholder, *) crossb(i)
|
||||
arg_pos = arg_pos + 1
|
||||
end do
|
||||
case('basis')
|
||||
call get_command_argument(arg_pos, textholder)
|
||||
read(textholder, *) basisnum(1)
|
||||
@ -275,11 +287,13 @@ module mode_create
|
||||
end select
|
||||
end do
|
||||
|
||||
|
||||
!Calculate the lattice periodicity length in lattice units
|
||||
do i = 1, 3
|
||||
lattice_space(i) = norm2(orient(i,:))
|
||||
end do
|
||||
|
||||
!Now normalize the orientation matrix
|
||||
orient = matrix_normal(orient,3)
|
||||
!Check special periodicity relations
|
||||
select case(trim(adjustl(element_type)))
|
||||
case('fcc', '20fcc')
|
||||
@ -309,8 +323,6 @@ module mode_create
|
||||
end if
|
||||
end do
|
||||
end select
|
||||
!Now normalize the orientation matrix
|
||||
orient = matrix_normal(orient,3)
|
||||
!Now check these to make sure they are right handed and orthogonal
|
||||
call check_right_ortho(orient, isortho, isrighthanded)
|
||||
if (.not.isortho) then
|
||||
@ -330,21 +342,22 @@ module mode_create
|
||||
call add_atom_type(name, basis_type(1,1)) !If basis command not defined then we use name as the atom_name
|
||||
basis_pos(:,1) = 0.0_dp
|
||||
end if
|
||||
!
|
||||
|
||||
end subroutine
|
||||
|
||||
subroutine build_with_rhomb(box_in_lat, transform_matrix, nn)
|
||||
subroutine build_with_rhomb(box_in_lat, transform_matrix, nn, transform_inverse)
|
||||
!This subroutine returns all the lattice points in the box in r_lat
|
||||
|
||||
!Inputs
|
||||
integer, dimension(3,8), intent(in) :: box_in_lat !The box vertices transformed to lattice space
|
||||
real(kind=dp), dimension(3,3), intent(in) :: transform_matrix !The transformation matrix from lattice_space to real space
|
||||
real(kind=dp), dimension(3,3), intent(in) :: transform_inverse !The inverse transform
|
||||
integer, intent(in) :: nn
|
||||
!Internal variables
|
||||
integer :: i, inod, bd_in_lat(6), bd_in_array(6), ix, iy, iz, numlatpoints, ele(3,nn), rzero(3), efill_size, &
|
||||
vlat(3), temp_lat(3,nn), m, n, o, j, k, nump_ele, efill_temp_lat(3,nn), filzero(3), &
|
||||
bd_ele_lat(6), efill_ele(3,nn), ebd(6)
|
||||
real(kind=dp) :: v(3), temp_nodes(3,1,nn), r(3), centroid_bd(6)
|
||||
bd_ele_lat(6), efill_ele(3,nn), ebd(6), shift_vec(3), type_interp(max_basisnum*max_esize**3)
|
||||
real(kind=dp) :: v(3), temp_nodes(3,1,nn), r(3), centroid_bd(6), vreal(3), r_interp(3, max_basisnum*max_esize**3)
|
||||
logical, allocatable :: lat_points(:,:,:)
|
||||
logical :: node_in_bd(nn), add, lat_points_ele(esize,esize,esize), intersect_bd(3)
|
||||
|
||||
@ -422,6 +435,7 @@ module mode_create
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
!Now we redefine bd_in_lat The first 3 indices contains limits for the lat_points array
|
||||
bd_in_array(1) = bd_in_lat(2) - bd_in_lat(1) + 10
|
||||
bd_in_array(2) = bd_in_lat(4) - bd_in_lat(3) + 10
|
||||
@ -493,6 +507,31 @@ module mode_create
|
||||
!If within array boundaries check to see if it is a lattice point
|
||||
else if(lat_points(vlat(1),vlat(2),vlat(3))) then
|
||||
node_in_bd(inod) = .true.
|
||||
else if(any(crossb)) then
|
||||
vreal=0
|
||||
do i = 1, 3
|
||||
if(crossb(i)) then
|
||||
if(temp_nodes(i,1,inod) < box_bd(2*i-1)) then
|
||||
vreal(i) = temp_nodes(i,1,inod)+box_len(i)
|
||||
else if(temp_nodes(i,1,inod) > box_bd(2*i)) then
|
||||
vreal(i) = temp_nodes(i,1,inod)-box_len(i)
|
||||
else
|
||||
vreal(i) = temp_nodes(i,1,inod)
|
||||
end if
|
||||
else
|
||||
vreal(i) = temp_nodes(i,1,inod)
|
||||
end if
|
||||
end do
|
||||
v = matmul(transform_inverse, matmul(orient_inv, vreal))
|
||||
do i = 1, 3
|
||||
vlat(i) = nint(v(i) - bd_in_lat(2*i-1)+5)
|
||||
end do
|
||||
if(any(vlat > shape(lat_points)).or.any(vlat < 1)) then
|
||||
continue
|
||||
!If within array boundaries check to see if it is a lattice point
|
||||
else if(lat_points(vlat(1),vlat(2),vlat(3))) then
|
||||
node_in_bd(inod) = .true.
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
|
||||
@ -502,6 +541,41 @@ module mode_create
|
||||
lat_ele_num = lat_ele_num+1
|
||||
r_lat(:,:,lat_ele_num) = temp_nodes(:,1,:)
|
||||
elat(lat_ele_num) = esize
|
||||
if(any(crossb)) then
|
||||
call interpolate_atoms('fcc', esize, 0, temp_nodes, type_interp, r_interp)
|
||||
j= 0
|
||||
do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:))
|
||||
do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:))
|
||||
do m = minval(temp_lat(1,:)), maxval(temp_lat(1,:))
|
||||
j=j+1
|
||||
do i = 1, 3
|
||||
if(crossb(i)) then
|
||||
if(r_interp(i,j) < box_bd(2*i-1)) then
|
||||
vreal(i) = r_interp(i,j)+box_len(i)
|
||||
else if(r_interp(i,j) > box_bd(2*i)) then
|
||||
vreal(i) = r_interp(i,j)-box_len(i)
|
||||
else
|
||||
vreal(i) = r_interp(i,j)
|
||||
end if
|
||||
else
|
||||
vreal(i) = r_interp(i,j)
|
||||
end if
|
||||
end do
|
||||
v = matmul(transform_inverse, matmul(orient_inv, vreal))
|
||||
do i = 1, 3
|
||||
vlat(i) = nint(v(i) - bd_in_lat(2*i-1)+5)
|
||||
end do
|
||||
|
||||
if(lat_points(vlat(1), vlat(2), vlat(3))) then
|
||||
lat_points(vlat(1), vlat(2), vlat(3)) = .false.
|
||||
else
|
||||
print *, "Lat points should be true not false"
|
||||
stop 2
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
else
|
||||
!Now set all the lattice points contained within an element to false
|
||||
do o = minval(temp_lat(3,:)), maxval(temp_lat(3,:))
|
||||
do n = minval(temp_lat(2,:)), maxval(temp_lat(2,:))
|
||||
@ -510,6 +584,7 @@ module mode_create
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
|
||||
!If any nodes are in the boundary and we want to efill then run the efill code
|
||||
else if(any(node_in_bd).and.efill) then
|
||||
|
||||
@ -63,6 +63,7 @@ module mode_metric
|
||||
|
||||
!Now loop over new files
|
||||
do i = 2, nfiles
|
||||
|
||||
call read_in(i, (/ 0.0_dp, 0.0_dp, 0.0_dp /), temp_box_bd)
|
||||
call convert_positions(r_curr, np_temp)
|
||||
if (npreal /= np_temp) then
|
||||
@ -196,6 +197,7 @@ module mode_metric
|
||||
rout = -huge(1.0_dp)
|
||||
if(atom_num > 0) then
|
||||
do i = 1, atom_num
|
||||
call apply_periodic(r_atom(:,i))
|
||||
rout(:,tag_atom(i)) = r_atom(:,i)
|
||||
npoints = npoints + 1
|
||||
end do
|
||||
@ -205,8 +207,11 @@ module mode_metric
|
||||
do i = 1, ele_num
|
||||
do inod = 1, ng_node(lat_ele(i))
|
||||
do ibasis = 1, basisnum(lat_ele(i))
|
||||
call apply_periodic(r_node(:,ibasis,inod,i))
|
||||
rout(:, atom_num+(tag_ele(i)-1)*max_ng_node*max_basisnum + (inod-1)*max_basisnum + ibasis) &
|
||||
= r_node(:,ibasis,inod,i)
|
||||
|
||||
|
||||
npoints = npoints + 1
|
||||
end do
|
||||
end do
|
||||
@ -226,14 +231,14 @@ module mode_metric
|
||||
|
||||
select case(metric_type)
|
||||
case('def_grad')
|
||||
write(11,*) "type element x y z F11 F12 F13 F21 F22 F23 F31 F32 F33"
|
||||
write(11,*) "id type element x y z F11 F12 F13 F21 F22 F23 F31 F32 F33"
|
||||
case('microrotation')
|
||||
write(11,*) "type element x y z micro1 micro2 micro3 norm2(micro)"
|
||||
write(11,*) "id type element x y z micro1 micro2 micro3 norm2(micro)"
|
||||
end select
|
||||
|
||||
if(atom_num > 0) then
|
||||
do i = 1, atom_num
|
||||
write(11,*) type_atom(i), 0, r_atom(:,i), met(:,tag_atom(i))
|
||||
write(11,*) tag_atom(i), type_atom(i), 0, r_atom(:,i), met(:,tag_atom(i))
|
||||
end do
|
||||
end if
|
||||
|
||||
@ -241,7 +246,8 @@ module mode_metric
|
||||
do i = 1, ele_num
|
||||
do inod = 1, ng_node(lat_ele(i))
|
||||
do ibasis = 1, basisnum(lat_ele(i))
|
||||
write(11,*) basis_type(ibasis,lat_ele(i)), 1, r_node(:,ibasis,inod,i), &
|
||||
write(11,*) atom_num+(tag_ele(i)-1)*max_ng_node*max_basisnum + (inod-1)*max_basisnum + ibasis, &
|
||||
basis_type(ibasis,lat_ele(i)), 1, r_node(:,ibasis,inod,i), &
|
||||
met(:, atom_num+(tag_ele(i)-1)*max_ng_node*max_basisnum + (inod-1)*max_basisnum + ibasis)
|
||||
end do
|
||||
end do
|
||||
|
||||
@ -54,7 +54,6 @@ module neighbors
|
||||
if(r_list(1,i) < box_bd(1)) cycle
|
||||
|
||||
!c is the position of the cell that the point belongs to
|
||||
if(i == 11651203) print *, r_list(:,i), (r_list(1,i) < box_bd(1))
|
||||
do j = 1, 3
|
||||
c(j) = int((r_list(j,i)-box_bd(2*j-1))/(rc_off)) + 1
|
||||
end do
|
||||
|
||||
@ -15,7 +15,7 @@ module opt_group
|
||||
character(len=15) :: type, gshape!Type indicates what element type is selected and shape is the group shape
|
||||
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, &
|
||||
insert_lattice, s_fractions(10)
|
||||
insert_lattice, s_fractions(10), max_height
|
||||
|
||||
logical :: displace, delete, max_remesh, refine, group_nodes, flip, efill, refinefill, alloy
|
||||
|
||||
@ -109,11 +109,11 @@ module opt_group
|
||||
call get_command_argument(arg_pos, type, arglen)
|
||||
if (arglen==0) STOP "Missing select_type in group command"
|
||||
select case(trim(adjustl(type)))
|
||||
case('atoms', 'elements', 'both')
|
||||
case('atoms', 'elements', 'all')
|
||||
continue
|
||||
case default
|
||||
print *, "Select_type ", trim(adjustl(type)), " is not an accept group selection criteria. ", &
|
||||
"Please select from atoms, elements, or both."
|
||||
"Please select from atoms, elements, or all."
|
||||
end select
|
||||
|
||||
arg_pos = arg_pos + 1
|
||||
@ -177,6 +177,57 @@ module opt_group
|
||||
end if
|
||||
end do
|
||||
|
||||
case('wedge_cut')
|
||||
arg_pos = arg_pos + 1
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if (arglen==0) STOP "Missing normal dim in group wedge_cut command"
|
||||
read(textholder,*) dim1
|
||||
|
||||
arg_pos = arg_pos + 1
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if (arglen==0) STOP "Missing normal dim in group wedge_cut command"
|
||||
read(textholder,*) dim2
|
||||
|
||||
do i = 1, 3
|
||||
arg_pos = arg_pos + 1
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if (arglen==0) STOP "Missing centroid in group wedge_cut command"
|
||||
call parse_pos(i, textholder, centroid(i))
|
||||
end do
|
||||
|
||||
arg_pos = arg_pos + 1
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if (arglen==0) STOP "Missing base width in group wedge_cut command"
|
||||
read(textholder,*) bwidth
|
||||
|
||||
arg_pos = arg_pos + 1
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if (arglen==0) STOP "Missing base width in group wedge_cut command"
|
||||
read(textholder,*) max_height
|
||||
|
||||
!Calculate the vertex positions
|
||||
vertices(:,1) = centroid
|
||||
vertices(dim2,1) = 0.0_dp
|
||||
do i = 1, 3
|
||||
if (i == dim1) then
|
||||
if (bwidth > 0) then
|
||||
vertices(i,2) = box_bd(2*i)
|
||||
vertices(i,3) = box_bd(2*i)
|
||||
else if (bwidth < 0) then
|
||||
vertices(i,2) = box_bd(2*i-1)
|
||||
vertices(i,3) = box_bd(2*i-1)
|
||||
else
|
||||
print *, "bwidth cannot be 0 in wedge gshaped group"
|
||||
stop 3
|
||||
end if
|
||||
else if (i == dim2) then
|
||||
vertices(i,2) = 0.0_dp
|
||||
vertices(i,3) = 0.0_dp
|
||||
else
|
||||
vertices(i,2) = centroid(i) + bwidth
|
||||
vertices(i,3) = centroid(i) - bwidth
|
||||
end if
|
||||
end do
|
||||
|
||||
case('notch')
|
||||
arg_pos = arg_pos + 1
|
||||
@ -239,7 +290,7 @@ module opt_group
|
||||
!Read the ID type shape for group
|
||||
case('id')
|
||||
arg_pos = arg_pos + 1
|
||||
!For this type we have to call different options if type is atoms, elements, or both. Both is the most complex.
|
||||
!For this type we have to call different options if type is atoms, elements, or all. all is the most complex.
|
||||
select case(trim(adjustl(type)))
|
||||
case('atoms')
|
||||
!Read number of ids
|
||||
@ -285,7 +336,7 @@ module opt_group
|
||||
end do
|
||||
group_ele_num = in_num
|
||||
|
||||
case('both')
|
||||
case('all')
|
||||
!We repeat this code twice, once for the atoms and once for the elements
|
||||
allocate(element_index(1024),atom_index(1024))
|
||||
do i = 1, 2
|
||||
@ -308,7 +359,7 @@ module opt_group
|
||||
select case(trim(adjustl(type_spec)))
|
||||
case('atoms','atom')
|
||||
if (group_atom_num > 0) then
|
||||
print *, "Atoms specifier used more than once in group id command with type both, either use type ", &
|
||||
print *, "Atoms specifier used more than once in group id command with type all, either use type ", &
|
||||
"atoms or include elements identifier"
|
||||
stop 3
|
||||
|
||||
@ -326,7 +377,7 @@ module opt_group
|
||||
|
||||
case('elements','element')
|
||||
if (group_ele_num > 0) then
|
||||
print *, "Elements specifier used more than once in group id command with type both, either use type ",&
|
||||
print *, "Elements specifier used more than once in group id command with type all, either use type ",&
|
||||
"elements or include atoms identifier"
|
||||
stop 3
|
||||
|
||||
@ -527,7 +578,7 @@ module opt_group
|
||||
allocate(element_index(1024), atom_index(1024))
|
||||
!Check the type to see whether we need to find the elements within the group
|
||||
select case(trim(adjustl(type)))
|
||||
case('elements', 'both')
|
||||
case('elements', 'all')
|
||||
do i = 1, ele_num
|
||||
if(in_group_ele(size_ele(i), lat_ele(i), r_node(:,:,:,i))) then
|
||||
group_ele_num = group_ele_num + 1
|
||||
@ -559,7 +610,7 @@ module opt_group
|
||||
end select
|
||||
!Check the type to see if we need to find the atoms within the group
|
||||
select case(trim(adjustl(type)))
|
||||
case('atoms','both')
|
||||
case('atoms','all')
|
||||
do i = 1, atom_num
|
||||
if(in_group(r_atom(:,i)).neqv.flip) then
|
||||
group_atom_num = group_atom_num + 1
|
||||
@ -1151,10 +1202,8 @@ module opt_group
|
||||
call add_atom_type(species_type(i), type_map(i))
|
||||
if(i > 1) s_fractions(i) = s_fractions(i) + s_fractions(i-1)
|
||||
end do
|
||||
print *, s_fractions
|
||||
!Now randomize the atom types
|
||||
added_types = 0
|
||||
print *, type_map(j)
|
||||
do i = 1, group_atom_num
|
||||
ia = atom_index(i)
|
||||
call random_number(rand)
|
||||
@ -1184,6 +1233,9 @@ module opt_group
|
||||
in_group=in_block_bd(r,block_bd)
|
||||
case('wedge')
|
||||
in_group = in_wedge_bd(r,vertices)
|
||||
case('wedge_cut')
|
||||
in_group = in_wedge_bd(r,vertices)
|
||||
in_group = in_group.and.((abs(r(dim1) - vertices(dim1,2)) < max_height))
|
||||
case('notch')
|
||||
do i = 1, 3
|
||||
if (.not.((dim1==i).or.(dim2==i))) dim3 = i
|
||||
|
||||
@ -2,6 +2,8 @@ module subroutines
|
||||
use parameters
|
||||
use functions
|
||||
use box
|
||||
use str
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: allostat, deallostat
|
||||
@ -149,12 +151,26 @@ module subroutines
|
||||
|
||||
subroutine parse_ori_vec(ori_string, ori_vec)
|
||||
!This subroutine parses a string to vector in the format [ijk]
|
||||
character(len=20), intent(in) :: ori_string
|
||||
character(*), intent(in) :: ori_string
|
||||
real(kind=dp), dimension(3), intent(out) :: ori_vec
|
||||
real(kind=dp) :: prefactor
|
||||
integer :: start, fin
|
||||
|
||||
integer :: i, ori_pos, stat
|
||||
|
||||
ori_pos=2
|
||||
do i = 1, len(ori_string)
|
||||
if(ori_string(i:i) == "[") then
|
||||
start=i+1
|
||||
else if(ori_string(i:i) == "]") then
|
||||
fin = i-1
|
||||
end if
|
||||
end do
|
||||
|
||||
ori_pos=start
|
||||
|
||||
if (tok_count(ori_string(start:fin)) == 3) then
|
||||
read(ori_string(start:fin),*) ori_vec(:)
|
||||
else
|
||||
do i = 1,3
|
||||
do while(ori_string(ori_pos:ori_pos)==' ')
|
||||
ori_pos=ori_pos+1
|
||||
@ -171,7 +187,7 @@ module subroutines
|
||||
ori_pos=ori_pos + 1
|
||||
end if
|
||||
end do
|
||||
|
||||
end if
|
||||
return
|
||||
end subroutine parse_ori_vec
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user