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

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

Browse Source 
Separated wrap option to reduce opy and pasted code. Fixed warnings a…
This commit is contained in:
aselimov 2020-01-29 10:26:29 -05:00 committed by GitHub
commit 1a23d21dba
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
11 changed files with 55 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/call_option.f90
View File

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

18
src/elements.f90
View File

@ -41,6 +41,8 @@ module elements
integer :: basis_type(10,10)
real(kind=dp) :: lapa(10)
!Additional module level variables we need
logical :: wrap_flag
public
contains
@ -313,7 +315,7 @@ module elements
real(kind=dp), dimension(3, max_basisnum*max_esize**3), intent(out) :: r_interp !Interpolated atomic positions
!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) :: t, s, r
@ -390,7 +392,7 @@ module elements
integer, intent(in) :: num
integer, intent(inout), dimension(num) :: index
integer :: i, j
integer :: i
call heapsort(index)
@ -413,7 +415,7 @@ module elements
integer, intent(in) :: num
integer, intent(inout), dimension(num) :: index
integer :: i, j
integer :: i
call heapsort(index)
@ -436,5 +438,15 @@ module elements
end if
ele_num = ele_num - 1
end do
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

2
src/io.f90
View File

@ -363,7 +363,7 @@ module io
!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.
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)
1 format('time' / i16, f23.15)

16
src/main.f90
View File

@ -39,20 +39,27 @@ program main
call box_init
call random_seed
force_overwrite=.false.
wrap_flag = .false.
end_mode_arg = 0
! Command line parsing
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
call get_command_argument(i,argument)
select case(trim(adjustl(argument)))
!This lets us know if we are overwriting all files
case('-ow')
force_overwrite = .true.
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 do
!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)
!Otherwise print that the argument is not accepted and move on
else
print *, trim(adjustl(argument)), " is not accepted. Skipping to next argument"
arg_pos = arg_pos + 1
print *, trim(adjustl(argument)), " is not an accepted command."
stop 3
end if
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
! Before building do a check on the file
if (outfilenum == 0) then

2
src/mode_convert.f90
View File

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

5
src/mode_create.f90
View File

@ -24,7 +24,6 @@ module mode_create
subroutine create(arg_pos)
! Main subroutine which controls execution
character(len=100) :: textholder
integer, intent(out) :: arg_pos
integer :: i, ibasis, inod
@ -128,7 +127,8 @@ module mode_create
!Now that it is built multiply by the 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
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), &
vlat(3), temp_lat(3,8), m, n, o
real(kind=dp) :: v(3), temp_nodes(3,1,8)
real(kind=dp), allocatable :: resize_lat_array(:,:)
logical, allocatable :: lat_points(:,:,:)
logical :: node_in_bd(8)

19
src/mode_merge.f90
View File

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

11
src/opt_disl.f90
View File

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

18
src/opt_group.f90
View File

@ -11,7 +11,7 @@ module opt_group
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
real(kind=dp) :: block_bd(6), disp_vec(3)
logical :: displace, wrap
logical :: displace
integer, allocatable :: element_index(:), atom_index(:)
@ -96,8 +96,6 @@ module opt_group
if (arglen==0) stop "Missing vector component for shift command"
read(textholder, *) disp_vec(i)
end do
case('wrap')
wrap = .true.
case('remesh')
arg_pos = arg_pos + 1
call get_command_argument(arg_pos, textholder, arglen)
@ -192,16 +190,8 @@ module opt_group
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
else
if (.not.(wrap_flag)) then
do i = 1,3
if (disp_vec(i) < -lim_zero) then
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
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
!they are in the box
!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
do j = 1, basisnum(lat_ele(ie))*size_ele(ie)**3
call apply_periodic(r_interp(:,j))
call add_atom(type_interp(j), r_interp(:,j))

2
src/parameters.f90
View File

@ -7,7 +7,7 @@ module parameters
!Parameters for floating point tolerance
real(kind=dp), parameter :: lim_zero = epsilon(1.0_dp), &
lim_large = huge(1.0_dp)
logical, save :: lmpcac
logical, save :: lmpcac
!Numeric constants
real(kind=dp), parameter :: pi = 3.14159265358979323846_dp

1
src/subroutines.f90
View File

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