Merge pull request #20 from aselimov/reorganize-wrap-option

Separated wrap option to reduce opy and pasted code. Fixed warnings a…
master
aselimov 5 years ago committed by GitHub
commit 1a23d21dba
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

@ -15,8 +15,11 @@ subroutine call_option(option, arg_pos)
case('-ow') case('-ow')
arg_pos = arg_pos + 1 arg_pos = arg_pos + 1
continue continue
case default case('-wrap')
print *, 'Option ', trim(adjustl(option)), ' is not currently accepted. Skipping to next argument'
arg_pos = arg_pos + 1 arg_pos = arg_pos + 1
continue
case default
print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.'
stop 3
end select end select
end subroutine call_option end subroutine call_option

@ -41,6 +41,8 @@ module elements
integer :: basis_type(10,10) integer :: basis_type(10,10)
real(kind=dp) :: lapa(10) real(kind=dp) :: lapa(10)
!Additional module level variables we need
logical :: wrap_flag
public public
contains contains
@ -313,7 +315,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
!Internal variables !Internal variables
integer :: i, it, is, ir, ibasis, inod, ia, bnum, lat_type_temp integer :: it, is, ir, ibasis, inod, ia, bnum, lat_type_temp
real(kind=dp), allocatable :: a_shape(:) real(kind=dp), allocatable :: a_shape(:)
real(kind=dp) :: t, s, r real(kind=dp) :: t, s, r
@ -390,7 +392,7 @@ module elements
integer, intent(in) :: num integer, intent(in) :: num
integer, intent(inout), dimension(num) :: index integer, intent(inout), dimension(num) :: index
integer :: i, j integer :: i
call heapsort(index) call heapsort(index)
@ -413,7 +415,7 @@ module elements
integer, intent(in) :: num integer, intent(in) :: num
integer, intent(inout), dimension(num) :: index integer, intent(inout), dimension(num) :: index
integer :: i, j integer :: i
call heapsort(index) call heapsort(index)
@ -436,5 +438,15 @@ module elements
end if end if
ele_num = ele_num - 1 ele_num = ele_num - 1
end do end do
end subroutine delete_elements end subroutine delete_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
end module elements end module elements

@ -363,7 +363,7 @@ module io
!NOTE: This code doesn't work for arbitrary number of basis atoms per node. It assumes that the !NOTE: This code doesn't work for arbitrary number of basis atoms per node. It assumes that the
!each element has only 1 atom type at the node. !each element has only 1 atom type at the node.
character(len=100), intent(in) :: file character(len=100), intent(in) :: file
integer :: interp_max, i, j, lat_size, inod, ibasis, ip, unique_index(10), unique_num integer :: interp_max, i, j, inod, ibasis, ip, unique_index(10), unique_num
real(kind=dp) :: box_vec(3) real(kind=dp) :: box_vec(3)
1 format('time' / i16, f23.15) 1 format('time' / i16, f23.15)

@ -39,20 +39,27 @@ program main
call box_init call box_init
call random_seed call random_seed
force_overwrite=.false. force_overwrite=.false.
wrap_flag = .false.
end_mode_arg = 0 end_mode_arg = 0
! Command line parsing ! Command line parsing
arg_num = command_argument_count() arg_num = command_argument_count()
!Check to see if overwrite flag is passed !First check to see if certain commands are passed, these commands must be known before code
!is executed.
do i = 1, arg_num do i = 1, arg_num
call get_command_argument(i,argument) call get_command_argument(i,argument)
select case(trim(adjustl(argument))) select case(trim(adjustl(argument)))
!This lets us know if we are overwriting all files
case('-ow') case('-ow')
force_overwrite = .true. force_overwrite = .true.
print *, "Overwrite flag passed, output files will be overwritten" print *, "Overwrite flag passed, output files will be overwritten"
!This lets us know if we need to wrap atomic positions back into the cell
case('-wrap')
wrap_flag=.true.
end select end select
end do end do
!Determine if a mode is being used and what it is. The first argument has to be the mode !Determine if a mode is being used and what it is. The first argument has to be the mode
@ -86,11 +93,14 @@ program main
call call_option(argument, arg_pos) call call_option(argument, arg_pos)
!Otherwise print that the argument is not accepted and move on !Otherwise print that the argument is not accepted and move on
else else
print *, trim(adjustl(argument)), " is not accepted. Skipping to next argument" print *, trim(adjustl(argument)), " is not an accepted command."
arg_pos = arg_pos + 1 stop 3
end if end if
end do end do
!If wrap flag was passed then call the wrap atoms command
if(wrap_flag) call wrap_atoms
!Check to make sure a file was passed to be written out and then write out !Check to make sure a file was passed to be written out and then write out
! Before building do a check on the file ! Before building do a check on the file
if (outfilenum == 0) then if (outfilenum == 0) then

@ -11,7 +11,7 @@ module mode_convert
subroutine convert(arg_pos) subroutine convert(arg_pos)
!This subroutine converts a single input file from one format to another !This subroutine converts a single input file from one format to another
integer, intent(out) :: arg_pos integer, intent(out) :: arg_pos
character(len=100) :: infile, outfile character(len=100) :: infile
real(kind = dp) :: temp_box_bd(6) real(kind = dp) :: temp_box_bd(6)
!First read in the file !First read in the file
call get_command_argument(2, infile) call get_command_argument(2, infile)

@ -24,7 +24,6 @@ module mode_create
subroutine create(arg_pos) subroutine create(arg_pos)
! Main subroutine which controls execution ! Main subroutine which controls execution
character(len=100) :: textholder
integer, intent(out) :: arg_pos integer, intent(out) :: arg_pos
integer :: i, ibasis, inod integer :: i, ibasis, inod
@ -128,7 +127,8 @@ module mode_create
!Now that it is built multiply by the lattice parameter !Now that it is built multiply by the lattice parameter
box_bd = box_bd*lattice_parameter box_bd = box_bd*lattice_parameter
print *, "Using mode create, ", lat_ele_num, " elements are created and ", lat_atom_num*basisnum(1), " atoms are created." print *, "Using mode create, ", lat_ele_num, " elements are created and ", lat_atom_num*basisnum(1), &
" atoms are created."
!Allocate variables !Allocate variables
call alloc_ele_arrays(lat_ele_num, lat_atom_num*basisnum(1)) call alloc_ele_arrays(lat_ele_num, lat_atom_num*basisnum(1))
@ -309,7 +309,6 @@ module mode_create
integer :: i, inod, bd_in_lat(6), bd_in_array(6), ix, iy, iz, numlatpoints, ele(3,8), rzero(3), & integer :: i, inod, bd_in_lat(6), bd_in_array(6), ix, iy, iz, numlatpoints, ele(3,8), rzero(3), &
vlat(3), temp_lat(3,8), m, n, o vlat(3), temp_lat(3,8), m, n, o
real(kind=dp) :: v(3), temp_nodes(3,1,8) real(kind=dp) :: v(3), temp_nodes(3,1,8)
real(kind=dp), allocatable :: resize_lat_array(:,:)
logical, allocatable :: lat_points(:,:,:) logical, allocatable :: lat_points(:,:,:)
logical :: node_in_bd(8) logical :: node_in_bd(8)

@ -10,7 +10,7 @@ module mode_merge
character(len=4) :: dim character(len=4) :: dim
integer :: in_num, new_starts(2) integer :: in_num, new_starts(2)
real(kind=dp) :: shift_vec(3) real(kind=dp) :: shift_vec(3)
logical :: wrap, shift_flag logical :: shift_flag
public public
contains contains
@ -22,7 +22,6 @@ module mode_merge
print *, '-----------------------Mode Merge---------------------------' print *, '-----------------------Mode Merge---------------------------'
wrap = .false.
shift_flag = .false. shift_flag = .false.
shift_vec(:) = 0.0_dp shift_vec(:) = 0.0_dp
@ -115,8 +114,6 @@ module mode_merge
if (arglen==0) stop "Missing vector component for shift command" if (arglen==0) stop "Missing vector component for shift command"
read(textholder, *) shift_vec(i) read(textholder, *) shift_vec(i)
end do end do
case('wrap')
wrap = .true.
case default case default
!If it isn't an available option to mode merge then we just exit !If it isn't an available option to mode merge then we just exit
exit exit
@ -126,13 +123,12 @@ module mode_merge
end subroutine parse_command end subroutine parse_command
subroutine shift(array_start, filenum) subroutine shift(array_start, filenum)
!This subroutine applies a shift to newly added atoms and elements. It also wraps the atoms !This subroutine applies a shift to newly added atoms and elements.
!if the user provides the wrap flag
integer, dimension(2), intent(in) :: array_start integer, dimension(2), intent(in) :: array_start
integer, intent(in) :: filenum integer, intent(in) :: filenum
integer :: i, j, ibasis, inod integer :: i, ibasis, inod
real(kind=dp), dimension(3) :: current_shift real(kind=dp), dimension(3) :: current_shift
@ -155,15 +151,8 @@ module mode_merge
end do end do
end do end do
!Now we check if we have to wrap the atoms, nodes are not wrapped. For elements the periodic
!boundary conditions are applied in the actual CAC codes
if(wrap) then
do i = array_start(1), atom_num
call apply_periodic(r_atom(:,i))
end do
!If we don't include the wrap command then we have to increase the size of the box !If we don't include the wrap command then we have to increase the size of the box
else if(.not.(wrap_flag)) then
do i = 1,3 do i = 1,3
if (current_shift(i) < -lim_zero) then if (current_shift(i) < -lim_zero) then
box_bd(2*i-1) = box_bd(2*i-1) - current_shift(i) box_bd(2*i-1) = box_bd(2*i-1) - current_shift(i)

@ -47,8 +47,8 @@ module opt_disl
integer, intent(inout) :: arg_pos integer, intent(inout) :: arg_pos
integer :: i,arglen integer :: i,arglen
character(len=8) :: ori_string
character(len=100) :: textholder character(len=100) :: textholder
character(len=8) :: ori_string
!Parse all of the commands !Parse all of the commands
arg_pos = arg_pos + 1 arg_pos = arg_pos + 1
@ -180,6 +180,9 @@ module opt_disl
end do end do
end if end if
!Now make sure all atoms are wrapped back into the simulation cell
call wrap_atoms
end subroutine dislgen end subroutine dislgen
subroutine parse_disloop(arg_pos) subroutine parse_disloop(arg_pos)
@ -187,8 +190,7 @@ module opt_disl
integer, intent(inout) :: arg_pos integer, intent(inout) :: arg_pos
integer :: i,arglen, sbox integer :: i,arglen
character(len=8) :: ori_string
character(len=100) :: textholder character(len=100) :: textholder
!Parse all of the commands !Parse all of the commands
@ -392,6 +394,9 @@ module opt_disl
end do end do
end do end do
return return
!Now make sure all atoms are wrapped back into the simulation cell
call wrap_atoms
end subroutine end subroutine
!******************************************************** !********************************************************

@ -11,7 +11,7 @@ module opt_group
integer :: group_ele_num, group_atom_num, remesh_size integer :: group_ele_num, group_atom_num, remesh_size
character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape character(len=15) :: type, shape !Type indicates what element type is selected and shape is the group shape
real(kind=dp) :: block_bd(6), disp_vec(3) real(kind=dp) :: block_bd(6), disp_vec(3)
logical :: displace, wrap logical :: displace
integer, allocatable :: element_index(:), atom_index(:) integer, allocatable :: element_index(:), atom_index(:)
@ -96,8 +96,6 @@ module opt_group
if (arglen==0) stop "Missing vector component for shift command" if (arglen==0) stop "Missing vector component for shift command"
read(textholder, *) disp_vec(i) read(textholder, *) disp_vec(i)
end do end do
case('wrap')
wrap = .true.
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)
@ -192,16 +190,8 @@ module opt_group
end do end do
end do end do
!Now either apply periodic boundaries if wrap command was passed or adjust box dimensions
!Now we check if we have to wrap the atoms, nodes are not wrapped. For elements the periodic
!boundary conditions are applied in the actual CAC codes
if(wrap) then
do i = 1, atom_num
call apply_periodic(r_atom(:,i))
end do
!If we don't include the wrap command then we have to increase the size of the box !If we don't include the wrap command then we have to increase the size of the box
else if (.not.(wrap_flag)) then
do i = 1,3 do i = 1,3
if (disp_vec(i) < -lim_zero) then if (disp_vec(i) < -lim_zero) then
box_bd(2*i-1) = box_bd(2*i-1) - disp_vec(i) box_bd(2*i-1) = box_bd(2*i-1) - disp_vec(i)
@ -235,8 +225,8 @@ module opt_group
!Get the interpolated atom positions !Get the interpolated atom positions
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)
!Loop over all interpolated atoms and add them to the system, we apply periodic boundaries here as well to make sure !Loop over all interpolated atoms and add them to the system, we apply periodic boundaries
!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(type_interp(j), r_interp(:,j)) call add_atom(type_interp(j), r_interp(:,j))

@ -5,6 +5,7 @@ module subroutines
implicit none implicit none
integer :: allostat, deallostat integer :: allostat, deallostat
public public
contains contains

Loading…
Cancel
Save