Alex Selimov
4 years ago
commit
5e56f2da10
@ -1,44 +1,49 @@
|
||||
FC=ifort
|
||||
#FFLAGS=-mcmodel=large -g -O0 -stand f08 -fpe0 -traceback -check bounds,uninit -warn all -implicitnone -no-wrap-margin -heap-arrays
|
||||
FFLAGS=-mcmodel=large -Ofast -no-wrap-margin -heap-arrays
|
||||
MODES=mode_create.o mode_merge.o mode_convert.o
|
||||
OPTIONS=opt_disl.o opt_group.o opt_orient.o opt_delete.o
|
||||
OBJECTS=main.o elements.o io.o subroutines.o functions.o atoms.o call_mode.o box.o $(MODES) $(OPTIONS) call_option.o sorts.o
|
||||
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .c .f .f90 .F90 .o
|
||||
.DEFAULT_GOAL := all
|
||||
|
||||
cacmb: $(OBJECTS)
|
||||
$(FC) $(FFLAGS) $(OBJECTS) parameters.o -o $@
|
||||
FC=mpif90
|
||||
FFLAGS=-Wall -mcmodel=large -O0 -g -fbacktrace -fcheck=all -ffpe-trap=invalid,zero,overflow,underflow,denormal
|
||||
|
||||
OBJDIR=obj
|
||||
SRCS := $(wildcard *.f90)
|
||||
OBJECTS := $(addprefix $(OBJDIR)/,$(SRCS:%.f90=%.o))
|
||||
|
||||
|
||||
|
||||
#----------------- DEPENDENCIES -----------------#
|
||||
# GENERATED USING https://github.com/ZedThree/fort_depend.py **requires python3**
|
||||
# > pip install fortdepend
|
||||
# > fortdepend -o Makefile.dep -i mpi -b obj/
|
||||
include Makefile.dep
|
||||
|
||||
#----------------- DEFAULTS -----------------#
|
||||
all: cacmb
|
||||
|
||||
.PHONY: deps
|
||||
cacmb: $(OBJECTS) $(OBJDIR)/main.o
|
||||
$(FC) $(FFLAGS) $(OBJECTS) -o $@
|
||||
|
||||
$(OBJDIR)/%.o: %.f90
|
||||
@mkdir -p $(@D)
|
||||
$(FC) $(FFLAGS) -c -o $@ $< -J$(OBJDIR)
|
||||
|
||||
.f90.o:
|
||||
$(FC) $(FFLAGS) -c $<
|
||||
|
||||
|
||||
deps:
|
||||
@fortdepend -o Makefile.dep -i mpi -b obj -w
|
||||
|
||||
#----------------- CLEAN UP -----------------#
|
||||
|
||||
.PHONY: clean
|
||||
clean:
|
||||
$(RM) cacmb *.o
|
||||
|
||||
testfuncs: testfuncs.o functions.o subroutines.o
|
||||
$(FC) testfuncs.o functions.o subroutines.o box.o elements.o -o $@
|
||||
|
||||
.PHONY: cleantest
|
||||
cleantest:
|
||||
$(RM) testfuncs testfuncs.o
|
||||
|
||||
.PHONY: test
|
||||
test: testfuncs
|
||||
./testfuncs
|
||||
|
||||
.PHONY: install
|
||||
install: cacmb
|
||||
cp ./cacmb /usr/local/bin
|
||||
|
||||
$(OBJECTS) : parameters.o
|
||||
atoms.o subroutines.o testfuncs.o box.o : functions.o
|
||||
main.o io.o $(MODES) $(OPTIONS) : elements.o
|
||||
call_mode.o : $(MODES)
|
||||
call_option.o : $(OPTIONS)
|
||||
elements.o : sorts.o
|
||||
$(MODES) $(OPTIONS) subroutines.o io.o : atoms.o box.o
|
||||
$(MODES) main.o : io.o
|
||||
testfuncs.o elements.o mode_create.o $(OPTIONS) $(MODES): subroutines.o
|
||||
clean:
|
||||
$(RM) *.mod *.o
|
||||
$(RM) $(OBJDIR)/*.mod $(OBJDIR)/*.o CAC
|
||||
@$(RM) -rf obj/
|
||||
|
||||
.PHONY: clean-all
|
||||
clean-all: clean
|
||||
|
||||
# DEBUGGING VARIABLE PRINT
|
||||
print-% : ; @echo $* = $($*)
|
||||
|
||||
@ -0,0 +1,167 @@
|
||||
# This file is generated automatically. DO NOT EDIT!
|
||||
|
||||
obj/main : \
|
||||
obj/atoms.o \
|
||||
obj/box.o \
|
||||
obj/caller.o \
|
||||
obj/elements.o \
|
||||
obj/functions.o \
|
||||
obj/io.o \
|
||||
obj/main.o \
|
||||
obj/mode_calc.o \
|
||||
obj/mode_convert.o \
|
||||
obj/mode_create.o \
|
||||
obj/mode_merge.o \
|
||||
obj/mode_metric.o \
|
||||
obj/neighbors.o \
|
||||
obj/opt_deform.o \
|
||||
obj/opt_delete.o \
|
||||
obj/opt_disl.o \
|
||||
obj/opt_group.o \
|
||||
obj/opt_orient.o \
|
||||
obj/opt_redef_box.o \
|
||||
obj/opt_slip_plane.o \
|
||||
obj/parameters.o \
|
||||
obj/sorts.o \
|
||||
obj/str.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/atoms.o : \
|
||||
obj/functions.o \
|
||||
obj/parameters.o
|
||||
|
||||
obj/box.o : \
|
||||
obj/functions.o \
|
||||
obj/parameters.o
|
||||
|
||||
obj/caller.o : \
|
||||
obj/box.o \
|
||||
obj/mode_calc.o \
|
||||
obj/mode_convert.o \
|
||||
obj/mode_create.o \
|
||||
obj/mode_merge.o \
|
||||
obj/mode_metric.o \
|
||||
obj/opt_deform.o \
|
||||
obj/opt_delete.o \
|
||||
obj/opt_disl.o \
|
||||
obj/opt_group.o \
|
||||
obj/opt_orient.o \
|
||||
obj/opt_redef_box.o \
|
||||
obj/opt_slip_plane.o \
|
||||
obj/parameters.o
|
||||
|
||||
obj/elements.o : \
|
||||
obj/box.o \
|
||||
obj/functions.o \
|
||||
obj/parameters.o \
|
||||
obj/sorts.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/functions.o : \
|
||||
obj/parameters.o
|
||||
|
||||
obj/io.o : \
|
||||
obj/atoms.o \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/parameters.o \
|
||||
obj/str.o
|
||||
|
||||
obj/main.o : \
|
||||
obj/caller.o \
|
||||
obj/elements.o \
|
||||
obj/io.o \
|
||||
obj/parameters.o
|
||||
|
||||
obj/mode_calc.o : \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/io.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/mode_convert.o : \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/io.o \
|
||||
obj/parameters.o
|
||||
|
||||
obj/mode_create.o : \
|
||||
obj/atoms.o \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/io.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/mode_merge.o : \
|
||||
obj/atoms.o \
|
||||
obj/elements.o \
|
||||
obj/io.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/mode_metric.o : \
|
||||
obj/elements.o \
|
||||
obj/io.o \
|
||||
obj/neighbors.o \
|
||||
obj/parameters.o
|
||||
|
||||
obj/neighbors.o : \
|
||||
obj/elements.o \
|
||||
obj/functions.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/opt_deform.o : \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/opt_delete.o : \
|
||||
obj/elements.o \
|
||||
obj/neighbors.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/opt_disl.o : \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/opt_group.o : \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/opt_orient.o : \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/opt_redef_box.o : \
|
||||
obj/box.o \
|
||||
obj/elements.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/opt_slip_plane.o : \
|
||||
obj/elements.o \
|
||||
obj/functions.o \
|
||||
obj/parameters.o \
|
||||
obj/subroutines.o
|
||||
|
||||
obj/parameters.o :
|
||||
|
||||
obj/sorts.o : \
|
||||
obj/parameters.o
|
||||
|
||||
obj/str.o :
|
||||
|
||||
obj/subroutines.o : \
|
||||
obj/box.o \
|
||||
obj/functions.o \
|
||||
obj/parameters.o
|
||||
@ -1,29 +0,0 @@
|
||||
subroutine call_mode(arg_pos,mode)
|
||||
!This code is used to parse the command line argument for the mode information and calls the required
|
||||
!mode module.
|
||||
|
||||
use mode_create
|
||||
use mode_convert
|
||||
use mode_merge
|
||||
use parameters
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(out) :: arg_pos
|
||||
character(len=100), intent(in) :: mode
|
||||
|
||||
select case(mode)
|
||||
case('--create')
|
||||
call create(arg_pos)
|
||||
case('--convert')
|
||||
call convert(arg_pos)
|
||||
case('--merge')
|
||||
call merge(arg_pos)
|
||||
case default
|
||||
print *, "Mode ", trim(adjustl(mode)), " currently not accepted. Please check documentation for ", &
|
||||
"accepted modes and rerun."
|
||||
|
||||
stop 3
|
||||
|
||||
end select
|
||||
end subroutine call_mode
|
||||
@ -1,40 +0,0 @@
|
||||
subroutine call_option(option, arg_pos)
|
||||
use parameters
|
||||
use opt_disl
|
||||
use opt_group
|
||||
use opt_orient
|
||||
use opt_delete
|
||||
use box
|
||||
implicit none
|
||||
|
||||
integer, intent(inout) :: arg_pos
|
||||
character(len=100), intent(in) :: option
|
||||
|
||||
select case(trim(adjustl(option)))
|
||||
case('-dislgen', '-disloop','-vacancydisloop')
|
||||
call dislocation(option, arg_pos)
|
||||
case('-group')
|
||||
call group(arg_pos)
|
||||
case('-ow')
|
||||
arg_pos = arg_pos + 1
|
||||
case('-wrap')
|
||||
arg_pos = arg_pos + 1
|
||||
case('-orient')
|
||||
call orient(arg_pos)
|
||||
case('-unorient')
|
||||
call unorient
|
||||
arg_pos = arg_pos + 1
|
||||
case('-boundary')
|
||||
arg_pos=arg_pos+1
|
||||
call get_command_argument(arg_pos, box_bc)
|
||||
arg_pos=arg_pos+1
|
||||
bound_called = .true.
|
||||
case('-sbox_ori')
|
||||
call sbox_ori(arg_pos)
|
||||
case('-delete')
|
||||
call run_delete(arg_pos)
|
||||
case default
|
||||
print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.'
|
||||
stop 3
|
||||
end select
|
||||
end subroutine call_option
|
||||
@ -0,0 +1,91 @@
|
||||
module caller
|
||||
!this module just calls modes and options
|
||||
|
||||
use mode_create
|
||||
use mode_convert
|
||||
use mode_merge
|
||||
use mode_metric
|
||||
use mode_calc
|
||||
use parameters
|
||||
use opt_disl
|
||||
use opt_group
|
||||
use opt_orient
|
||||
use opt_deform
|
||||
use opt_delete
|
||||
use opt_redef_box
|
||||
use opt_slip_plane
|
||||
use box
|
||||
|
||||
|
||||
implicit none
|
||||
public
|
||||
contains
|
||||
subroutine call_mode(arg_pos)
|
||||
!This code is used to parse the command line argument for the mode information and calls the required
|
||||
!mode module.
|
||||
|
||||
integer, intent(out) :: arg_pos
|
||||
|
||||
select case(mode)
|
||||
case('--create')
|
||||
call create(arg_pos)
|
||||
case('--convert')
|
||||
call convert(arg_pos)
|
||||
case('--merge')
|
||||
call merge(arg_pos)
|
||||
case('--metric')
|
||||
call metric(arg_pos)
|
||||
case('--calc')
|
||||
call calc(arg_pos)
|
||||
case default
|
||||
print *, "Mode ", trim(adjustl(mode)), " currently not accepted. Please check documentation for ", &
|
||||
"accepted modes and rerun."
|
||||
|
||||
stop 3
|
||||
end select
|
||||
end subroutine call_mode
|
||||
|
||||
subroutine call_option(option, arg_pos)
|
||||
integer, intent(inout) :: arg_pos
|
||||
character(len=100), intent(in) :: option
|
||||
|
||||
select case(trim(adjustl(option)))
|
||||
case('-disl','-dislgen', '-disloop','-vacancydisloop')
|
||||
call dislocation(option, arg_pos)
|
||||
case('-group')
|
||||
call group(arg_pos)
|
||||
case('-ow')
|
||||
arg_pos = arg_pos + 1
|
||||
case('-wrap')
|
||||
arg_pos = arg_pos + 1
|
||||
case('-orient')
|
||||
call orient_opt(arg_pos)
|
||||
case('-unorient')
|
||||
call unorient
|
||||
arg_pos = arg_pos + 1
|
||||
case('-boundary')
|
||||
arg_pos=arg_pos+1
|
||||
call get_command_argument(arg_pos, box_bc)
|
||||
arg_pos=arg_pos+1
|
||||
bound_called = .true.
|
||||
case('-sbox_ori')
|
||||
call sbox_ori(arg_pos)
|
||||
case('-deform')
|
||||
call deform(arg_pos)
|
||||
case('-delete')
|
||||
call run_delete(arg_pos)
|
||||
case('-set_cac')
|
||||
arg_pos=arg_pos +3
|
||||
case('-set_types')
|
||||
arg_pos = arg_pos + 3 + atom_types
|
||||
case('-redef_box')
|
||||
call redef_box(arg_pos)
|
||||
case('-slip_plane')
|
||||
call run_slip_plane(arg_pos)
|
||||
case default
|
||||
print *, 'Option ', trim(adjustl(option)), ' is not currently accepted.'
|
||||
stop 3
|
||||
end select
|
||||
end subroutine call_option
|
||||
|
||||
end module caller
|
||||
@ -0,0 +1,95 @@
|
||||
module mode_calc
|
||||
!This mode is used to calculate various quantities based on input information
|
||||
use parameters
|
||||
use io
|
||||
use subroutines
|
||||
use elements
|
||||
use box
|
||||
|
||||
character(len=100) :: calc_opt
|
||||
real(kind=dp), allocatable :: calculated(:)
|
||||
public
|
||||
contains
|
||||
subroutine calc(arg_pos)
|
||||
!Main calling subroutine for mode_create
|
||||
integer, intent(out) :: arg_pos
|
||||
|
||||
print *, '------------------------Mode Calc----------------------------'
|
||||
|
||||
!First parse command
|
||||
call parse(arg_pos)
|
||||
|
||||
print *, "Calculating ", trim(adjustl(calc_opt)), " for ", ele_num, " elements and ", atom_num, " atoms."
|
||||
!Now call the correct calc function based on calc_opt
|
||||
select case(trim(adjustl(calc_opt)))
|
||||
case('tot_virial')
|
||||
allocate(calculated(6))
|
||||
call calc_tot_virial
|
||||
case default
|
||||
print *, trim(adjustl(calc_opt)), " is not accepted as a calc option in mode_calc"
|
||||
stop 3
|
||||
end select
|
||||
end subroutine calc
|
||||
|
||||
subroutine parse(arg_pos)
|
||||
!This parses the mode calc options
|
||||
integer, intent(out) :: arg_pos
|
||||
|
||||
character(len = 100) :: infile
|
||||
integer:: arglen
|
||||
real(kind=dp) :: temp_box_bd(6)
|
||||
|
||||
call get_command_argument(2, infile, arglen)
|
||||
if (arglen == 0 ) stop "Missing calc option in mode calc"
|
||||
call get_in_file(infile)
|
||||
call read_in(1, (/0.0_dp, 0.0_dp, 0.0_dp /), temp_box_bd)
|
||||
call grow_box(temp_box_bd)
|
||||
|
||||
call get_command_argument(3, calc_opt, arglen)
|
||||
if (arglen == 0 ) stop "Missing calc option in mode calc"
|
||||
|
||||
arg_pos = 4
|
||||
end subroutine parse
|
||||
|
||||
subroutine calc_tot_virial
|
||||
!Calculate the the total box pressure in GPa
|
||||
|
||||
integer :: i, j, ibasis, inod
|
||||
real(kind=dp) :: avg_virial(6)
|
||||
|
||||
!First check to make sure that the virial was set for the atoms/elements
|
||||
if(.not.vflag) then
|
||||
print *, "Virial data has not been sent/may not be available with your current input file "
|
||||
stop 3
|
||||
end if
|
||||
|
||||
!Sum the atom virials
|
||||
calculated = 0
|
||||
do i = 1, atom_num
|
||||
do j = 1, 6
|
||||
calculated(j) = calculated(j) + virial_atom(j, i)
|
||||
end do
|
||||
end do
|
||||
|
||||
!Sum the nodal virials
|
||||
do i = 1, ele_num
|
||||
avg_virial(:) = 0
|
||||
do inod = 1, ng_node(lat_ele(i))
|
||||
do ibasis = 1, basisnum(lat_ele(i))
|
||||
do j = 1,6
|
||||
avg_virial(j) = avg_virial(j) + virial_node(j,ibasis,inod,i)/(basisnum(lat_ele(i))*ng_node(lat_ele(i)))
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
!Now add the total virial from the element
|
||||
calculated = calculated + avg_virial*(esize**3.0_dp)
|
||||
end do
|
||||
|
||||
!Now calculate the total box virial and convert to GPa
|
||||
calculated = evtogp(calculated)/box_volume()
|
||||
|
||||
print *, "Total virial is calculated as : (v11, v22, v33, v32, v31, v21)"
|
||||
print *, calculated
|
||||
end subroutine
|
||||
end module mode_calc
|
||||
@ -0,0 +1,249 @@
|
||||
module mode_metric
|
||||
!This mode is used to calculate continuum metrics for the j
|
||||
|
||||
use parameters
|
||||
use io
|
||||
use elements
|
||||
use neighbors
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: nfiles
|
||||
character(len=100) :: metric_type
|
||||
real(kind=dp) :: rc_off
|
||||
|
||||
!Save reference positions
|
||||
integer :: np, npreal, nmet
|
||||
real(kind=dp), allocatable :: r_zero(:,:), r_curr(:,:), met(:,:)
|
||||
|
||||
public
|
||||
contains
|
||||
subroutine metric(arg_pos)
|
||||
!This is the main calling subroutine for the metric code
|
||||
integer, intent(out) :: arg_pos
|
||||
character(len=100) :: infile, outfile
|
||||
|
||||
integer :: i, ibasis, inod, np_temp, ppos
|
||||
real(kind=dp), dimension(6) :: temp_box_bd
|
||||
|
||||
!These are the variables containing the cell list information
|
||||
integer, dimension(3) :: cell_num
|
||||
integer, allocatable :: num_in_cell(:,:,:), which_cell(:,:)
|
||||
integer, allocatable :: cell_list(:,:,:,:)
|
||||
|
||||
!Parse the command arguments
|
||||
call parse_command(arg_pos)
|
||||
|
||||
!Now read the first file
|
||||
call read_in(1, (/ 0.0_dp, 0.0_dp, 0.0_dp /), temp_box_bd)
|
||||
np = atom_num + max_basisnum*max_ng_node*ele_num
|
||||
allocate(r_zero(3,atom_num+max_basisnum*max_ng_node*ele_num), &
|
||||
r_curr(3,atom_num+max_basisnum*max_ng_node*ele_num))
|
||||
r_zero(:,:) = -huge(1.0_dp)
|
||||
|
||||
!Set up the met variable for the user desired metric
|
||||
select case(trim(adjustl(metric_type)))
|
||||
case('def_grad')
|
||||
allocate(met(9, np))
|
||||
case('microrotation')
|
||||
allocate(met(4,np))
|
||||
end select
|
||||
|
||||
!Now set the reference positions
|
||||
call convert_positions(r_zero, npreal)
|
||||
|
||||
!Now calculate the neighbor list for the reference configuration
|
||||
call calc_neighbor(5.0_dp, r_zero, np)
|
||||
|
||||
!Reset element and box
|
||||
call reset_data
|
||||
call reset_box
|
||||
|
||||
!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
|
||||
print *, "Error in mode_metric where number of points in ", i, "th file is ", np_temp, " and number of points in" &
|
||||
// "reference file is", npreal
|
||||
end if
|
||||
call calc_metric
|
||||
!Now create the output file num and write out to xyz format
|
||||
ppos = scan(trim(infiles(i)),".", BACK= .true.)
|
||||
if ( ppos > 0 ) then
|
||||
outfile = infiles(i)(1:ppos)//'xyz'
|
||||
else
|
||||
outfile = infiles(i)//'.xyz'
|
||||
end if
|
||||
call write_metric_xyz(outfile)
|
||||
call reset_data
|
||||
call reset_box
|
||||
end do
|
||||
end subroutine metric
|
||||
|
||||
subroutine parse_command(arg_pos)
|
||||
!This subroutine parses the arguments for mode metric
|
||||
integer, intent(out) :: arg_pos
|
||||
|
||||
integer :: i, arglen
|
||||
character(len=100) :: textholder
|
||||
logical :: file_exists
|
||||
|
||||
!First read the metric to be used
|
||||
call get_command_argument(2,metric_type,arglen)
|
||||
if (arglen == 0) stop "Incomplete mode metric command, check documentation"
|
||||
select case(trim(adjustl(metric_type)))
|
||||
case("microrotation", "def_grad")
|
||||
continue
|
||||
case default
|
||||
print *, "Mode metric does not accept metric ", metric_type, ". Please select from: microrotation, def_grad"
|
||||
stop 3
|
||||
end select
|
||||
|
||||
!Now read the cutoff radius
|
||||
call get_command_argument(3,textholder,arglen)
|
||||
if (arglen == 0) stop "Incomplete mode metric command, check documentation"
|
||||
read(textholder, *) rc_off
|
||||
|
||||
!Now read the number of files to read and allocate the variables
|
||||
call get_command_argument(4, textholder, arglen)
|
||||
if (arglen == 0) stop "Incomplete mode metric command, check documentation"
|
||||
read(textholder, *) nfiles
|
||||
|
||||
!Now read the files to be read
|
||||
do i = 1, nfiles
|
||||
call get_command_argument(4+i, textholder, arglen)
|
||||
call get_in_file(textholder)
|
||||
end do
|
||||
|
||||
arg_pos = 5+nfiles
|
||||
return
|
||||
end subroutine parse_command
|
||||
|
||||
subroutine calc_metric
|
||||
!This subroutine calculates the continuum metric that we require
|
||||
integer :: i, j, k, nei, ip, jp
|
||||
real(kind=dp) :: def_grad(3,3), omega(3,3), eta(3,3), rij(3), eta_inv(3,3), ftf(3,3), &
|
||||
U(3,3), R(3,3), Rskew(3,3), oldrij(3)
|
||||
|
||||
!Loop over all points
|
||||
do ip = 1, np
|
||||
eta(:,:) = 0.0_dp
|
||||
omega(:,:) = 0.0_dp
|
||||
def_grad(:,:) = 0.0_dp
|
||||
do jp = 1, nei_num(ip)
|
||||
!Calculate the neighbor vec in current configuration
|
||||
nei = nei_list(jp, ip)
|
||||
rij = r_curr(:,nei) - r_curr(:,ip)
|
||||
oldrij = r_zero(:,nei) - r_zero(:,ip)
|
||||
|
||||
!Calculate eta and omega
|
||||
do i = 1,3
|
||||
do j = 1,3
|
||||
omega(i,j) = omega(i,j) + rij(i) * oldrij(j)
|
||||
eta(i,j) = eta(i,j) + oldrij(i) * oldrij(j)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
eta_inv=matinv3(eta)
|
||||
def_grad=matmul(omega,eta_inv)
|
||||
|
||||
select case(trim(adjustl(metric_type)))
|
||||
case('def_grad')
|
||||
k = 1
|
||||
do i = 1,3
|
||||
do j = 1, 3
|
||||
met(k, ip) = def_grad(i,j)
|
||||
k = k + 1
|
||||
end do
|
||||
end do
|
||||
case('microrotation')
|
||||
met(:,ip) = 0.0_dp
|
||||
if(.not.all(def_grad == 0)) then
|
||||
!Now calculate microrotation
|
||||
ftf = matmul(transpose3(def_grad), def_grad)
|
||||
U = sqrt3(ftf)
|
||||
if(.not.all(abs(U) < lim_zero)) then
|
||||
R = matmul(def_grad, matinv3(U))
|
||||
Rskew = 0.5_dp * ( R - transpose3(R))
|
||||
do k =1,3
|
||||
do j = 1,3
|
||||
do i = 1,3
|
||||
met(k,ip) = met(k,ip) -0.5*permutation(i,j,k)*Rskew(i,j)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
met(4,ip) = norm2(met(1:3,ip))
|
||||
end if
|
||||
end if
|
||||
end select
|
||||
end do
|
||||
return
|
||||
end subroutine
|
||||
|
||||
subroutine convert_positions(rout, npoints)
|
||||
!This subroutine just converts current atom and element arrays to a single point based form
|
||||
real(kind=dp), dimension(3,atom_num+max_ng_node*max_basisnum*ele_num), intent(inout) :: rout
|
||||
integer, intent(out) :: npoints
|
||||
|
||||
integer :: i, inod, ibasis
|
||||
|
||||
npoints=0
|
||||
|
||||
if(atom_num > 0) then
|
||||
do i = 1, atom_num
|
||||
rout(:,tag_atom(i)) = r_atom(:,i)
|
||||
npoints = npoints + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
if (ele_num > 0) then
|
||||
do i = 1, ele_num
|
||||
do inod = 1, ng_node(lat_ele(i))
|
||||
do ibasis = 1, basisnum(lat_ele(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
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine convert_positions
|
||||
|
||||
subroutine write_metric_xyz(outfile)
|
||||
character(len=100), intent(in) :: outfile
|
||||
|
||||
integer :: i, inod, ibasis
|
||||
real(kind = dp) :: r(3), eng
|
||||
open (unit=11, file=trim(adjustl(outfile)), action='write', position='rewind', status = 'replace')
|
||||
!Write the header
|
||||
write(11,*) npreal
|
||||
|
||||
select case(metric_type)
|
||||
case('def_grad')
|
||||
write(11,*) "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)"
|
||||
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))
|
||||
end do
|
||||
end if
|
||||
|
||||
if (ele_num > 0) then
|
||||
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), &
|
||||
met(:, atom_num+(tag_ele(i)-1)*max_ng_node*max_basisnum + (inod-1)*max_basisnum + ibasis)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
end subroutine write_metric_xyz
|
||||
|
||||
end module mode_metric
|
||||
@ -0,0 +1,142 @@
|
||||
module neighbors
|
||||
|
||||
use parameters
|
||||
use elements
|
||||
use subroutines
|
||||
use functions
|
||||
|
||||
integer, allocatable :: nei_list(:,:), nei_num(:)
|
||||
real(kind=dp), allocatable :: init_vec(:,:,:), output(:), microrotation(:,:)
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine build_cell_list(numinlist, r_list, rc_off, cell_num, num_in_cell, cell_list, which_cell)
|
||||
!This subroutine builds a cell list based on rc_off
|
||||
|
||||
!----------------------------------------Input/output variables-------------------------------------------
|
||||
|
||||
integer, intent(in) :: numinlist !The number of points within r_list
|
||||
|
||||
real(kind=dp), dimension(3,numinlist), intent(in) :: r_list !List of points to be used for the construction of
|
||||
!the cell list.
|
||||
|
||||
real(kind=dp), intent(in) :: rc_off ! Cutoff radius which dictates the size of the cells
|
||||
|
||||
integer, dimension(3), intent(inout) :: cell_num !Number of cells in each dimension.
|
||||
|
||||
integer, allocatable, intent(inout) :: num_in_cell(:,:,:) !Number of points within each cell
|
||||
|
||||
integer, allocatable, intent(inout) :: cell_list(:,:,:,:) !Index of points from r_list within each cell.
|
||||
|
||||
integer, dimension(3,numinlist), intent(out) :: which_cell !The cell index for each point in r_list
|
||||
|
||||
!----------------------------------------Begin Subroutine -------------------------------------------
|
||||
|
||||
integer :: i, j, cell_lim, c(3)
|
||||
real(kind=dp) :: box_len(3)
|
||||
integer, allocatable :: resize_cell_list(:,:,:,:)
|
||||
|
||||
!First calculate the number of cells that we need in each dimension
|
||||
do i = 1,3
|
||||
box_len(i) = box_bd(2*i) - box_bd(2*i-1)
|
||||
cell_num(i) = int(box_len(i)/(rc_off/2))+1
|
||||
end do
|
||||
|
||||
!Initialize/allocate variables
|
||||
cell_lim = 10
|
||||
allocate(num_in_cell(cell_num(1),cell_num(2),cell_num(3)), cell_list(cell_lim, cell_num(1), cell_num(2), cell_num(3)))
|
||||
|
||||
!Now place points within cell
|
||||
do i = 1, numinlist
|
||||
!Check to see if the current point is a filler point and if so just skip it
|
||||
if(r_list(1,i) < -huge(1.0_dp)+1) cycle
|
||||
|
||||
!c is the position of the cell that the point belongs to
|
||||
do j = 1, 3
|
||||
c(j) = int((r_list(j,i)-box_bd(2*j-1))/(rc_off/2)) + 1
|
||||
end do
|
||||
|
||||
!Place the index in the correct position, growing if necessary
|
||||
num_in_cell(c(1),c(2),c(3)) = num_in_cell(c(1),c(2),c(3)) + 1
|
||||
if (num_in_cell(c(1),c(2),c(3)) > cell_lim) then
|
||||
allocate(resize_cell_list(cell_lim+10,cell_num(1),cell_num(2),cell_num(3)))
|
||||
resize_cell_list(1:cell_lim, :, :, :) = cell_list
|
||||
resize_cell_list(cell_lim+1:, :, :, :) = 0
|
||||
call move_alloc(resize_cell_list, cell_list)
|
||||
end if
|
||||
|
||||
cell_list(num_in_cell(c(1),c(2),c(3)),c(1),c(2),c(3)) = i
|
||||
which_cell(:,i) = c
|
||||
end do
|
||||
|
||||
return
|
||||
end subroutine build_cell_list
|
||||
|
||||
subroutine calc_neighbor(rc_off, r_list, n)
|
||||
!This function populates the neighbor list in this module
|
||||
|
||||
real(kind=dp), intent(in) :: rc_off
|
||||
integer, intent(in) :: n
|
||||
real(kind=dp), dimension(3,n) :: r_list
|
||||
|
||||
integer :: i, c(3), ci, cj, ck, num_nei, nei
|
||||
!Variables for cell list code
|
||||
integer, dimension(3) ::cell_num
|
||||
integer, allocatable :: num_in_cell(:,:,:), cell_list(:,:,:,:)
|
||||
integer :: which_cell(3,n)
|
||||
|
||||
!First reallocate the neighbor list codes
|
||||
if (allocated(nei_list)) then
|
||||
deallocate(nei_list,nei_num)
|
||||
end if
|
||||
|
||||
allocate(nei_list(100,n),nei_num(n))
|
||||
|
||||
!Now first pass the position list and and point num to the cell algorithm
|
||||
call build_cell_list(n, r_list, rc_off, cell_num, num_in_cell, cell_list, which_cell)
|
||||
|
||||
!Now loop over every point and find it's neighbors
|
||||
pointloop: do i = 1, n
|
||||
|
||||
!First check to see if the point is a filler point, if so then skip it
|
||||
if(r_list(1,i) < -Huge(-1.0_dp)+1) cycle
|
||||
|
||||
!c is the position of the cell that the point
|
||||
c = which_cell(:,i)
|
||||
|
||||
!Loop over all neighboring cells
|
||||
do ci = -1, 1, 1
|
||||
do cj = -1, 1, 1
|
||||
do ck = -1, 1, 1
|
||||
!First check to make sure that the neighboring cell exists
|
||||
if(any((c + (/ ck, cj, ci /)) == 0)) cycle
|
||||
if( (c(1) + ck > cell_num(1)).or.(c(2) + cj > cell_num(2)).or. &
|
||||
(c(3) + ci > cell_num(3))) cycle
|
||||
|
||||
do num_nei = 1, num_in_cell(c(1) + ck, c(2) + cj, c(3) + ci)
|
||||
nei = cell_list(num_nei,c(1) + ck, c(2) + cj, c(3) + ci)
|
||||
|
||||
!Check to make sure the atom isn't the same index as the atom we are checking
|
||||
!and that the neighbor hasn't already been deleted
|
||||
if((nei /= i)) then
|
||||
|
||||
!Now check to see if it is in the cutoff radius, if it is add it to the neighbor list for that
|
||||
!atom and calculate the initial neighbor vector
|
||||
if (norm2(r_list(:,nei)-r_list(:,i)) < rc_off) then
|
||||
|
||||
nei_num(i) = nei_num(i) + 1
|
||||
nei_list(nei_num(i), i) = nei
|
||||
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end do pointloop
|
||||
|
||||
return
|
||||
end subroutine calc_neighbor
|
||||
|
||||
end module neighbors
|
||||
@ -0,0 +1,98 @@
|
||||
module opt_deform
|
||||
!This module constains the deform option which applies a uniaxial strain to the system
|
||||
use parameters
|
||||
use subroutines
|
||||
use elements
|
||||
use box
|
||||
|
||||
implicit none
|
||||
|
||||
|
||||
real(kind=dp), save :: applied_strain
|
||||
integer, save :: sdim
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine deform(arg_pos)
|
||||
!This subroutine applies the simulation box deformation to the system
|
||||
|
||||
integer, intent(inout) :: arg_pos
|
||||
|
||||
character(len=1) :: dims(3)
|
||||
integer :: i, j, k
|
||||
real(kind=dp) :: frac_atom(atom_num), frac_node(max_basisnum, max_ng_node, ele_num)
|
||||
|
||||
!initialize some variables
|
||||
dims(1) = 'x'
|
||||
dims(2) = 'y'
|
||||
dims(3) = 'z'
|
||||
|
||||
!First parse the input command
|
||||
call parse_deform(arg_pos)
|
||||
print *, '-----------------------Option Deform------------------------'
|
||||
!Now convert all positions in the specified dimension to fractional coordinates
|
||||
do i = 1, atom_num
|
||||
frac_atom(i) = (r_atom(sdim, i) - box_bd(2*sdim-1))/(box_bd(2*sdim)-box_bd(2*sdim-1))
|
||||
end do
|
||||
do i = 1, ele_num
|
||||
do j = 1, ng_node(lat_ele(i))
|
||||
do k = 1, basisnum(lat_ele(i))
|
||||
frac_node(k,j,i) = (r_node(sdim,k,j,i) - box_bd(2*sdim-1))/(box_bd(2*sdim)-box_bd(2*sdim-1))
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
print *, "Original box bounds in ", dims(sdim), " are ", box_bd(2*sdim-1:2*sdim)
|
||||
box_bd(2*sdim) = box_bd(2*sdim) + applied_strain
|
||||
print *, "New box bounds are ", box_bd(2*sdim-1:2*sdim)
|
||||
|
||||
!Now reassign the positions
|
||||
do i = 1, atom_num
|
||||
r_atom(sdim,i) = frac_atom(i)*(box_bd(2*sdim)-box_bd(2*sdim-1)) + box_bd(2*sdim-1)
|
||||
end do
|
||||
do i = 1, ele_num
|
||||
do j = 1, ng_node(lat_ele(i))
|
||||
do k = 1, basisnum(lat_ele(i))
|
||||
r_node(sdim,k,j,i) = frac_node(k,j,i)*(box_bd(2*sdim)-box_bd(2*sdim-1)) + box_bd(2*sdim-1)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine deform
|
||||
|
||||
subroutine parse_deform(arg_pos)
|
||||
|
||||
integer, intent(inout) :: arg_pos
|
||||
integer :: arg_len
|
||||
character(len=100) :: textholder
|
||||
|
||||
!Pull out the dimension to be strained
|
||||
arg_pos=arg_pos+1
|
||||
call get_command_argument(arg_pos, textholder, arg_len)
|
||||
if (arg_len == 0) stop "Missing dim in deform command"
|
||||
|
||||
select case(trim(adjustl(textholder)))
|
||||
case('x','X')
|
||||
sdim = 1
|
||||
case('y','Y')
|
||||
sdim = 2
|
||||
case('z','Z')
|
||||
sdim = 3
|
||||
case default
|
||||
print *, "Dimension ", trim(adjustl(textholder)), " is not accepted. Please select either x, y, or z"
|
||||
end select
|
||||
|
||||
!Now pull out the strain vector, currently only accepts a real number by which to reduce the simulation cell size by in
|
||||
!that dimension
|
||||
arg_pos = arg_pos + 1
|
||||
call get_command_argument(arg_pos, textholder, arg_len)
|
||||
if (arg_len == 0) stop "Missing strain in deform command"
|
||||
read(textholder, *) applied_strain
|
||||
|
||||
arg_pos = arg_pos + 1
|
||||
|
||||
end subroutine parse_deform
|
||||
|
||||
|
||||
end module opt_deform
|
||||
@ -0,0 +1,131 @@
|
||||
module opt_redef_box
|
||||
|
||||
use box
|
||||
use elements
|
||||
use subroutines
|
||||
implicit none
|
||||
|
||||
character(len=3) :: redef_dim, new_bc
|
||||
real(kind=dp) :: new_bd(6)
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine redef_box(arg_pos)
|
||||
!This is the main calling function for opt_redef_box
|
||||
integer, intent(inout) :: arg_pos
|
||||
integer :: i, inod, ibasis, iatom, delete_list(atom_num), delete_num, type_interp(max_basisnum*max_esize**3)
|
||||
real(kind=dp):: r_interp(3, max_basisnum*max_esize**3)
|
||||
logical :: node_out(8)
|
||||
|
||||
!First parse the argument
|
||||
call parse_redef_box(arg_pos)
|
||||
|
||||
print *, '------------------------------------------------------------'
|
||||
print *, 'Option redef_box'
|
||||
print *, '------------------------------------------------------------'
|
||||
|
||||
!Now first filter atoms that don't fit in the new box bounds and delete them
|
||||
delete_num = 0
|
||||
do i = 1, atom_num
|
||||
if(.not.in_block_bd(r_atom(:,i),new_bd)) then
|
||||
delete_num = delete_num + 1
|
||||
delete_list(delete_num) = i
|
||||
end if
|
||||
end do
|
||||
call delete_atoms(delete_num, delete_list(1:delete_num))
|
||||
|
||||
!Now loop over all elements
|
||||
delete_num = 0
|
||||
delete_list(:) = 0
|
||||
do i = 1, ele_num
|
||||
!Determine if all nodes are within the new boundaries
|
||||
node_out(:) = .false.
|
||||
do inod = 1, ng_node(lat_ele(i))
|
||||
do ibasis = 1, basisnum(lat_ele(i))
|
||||
if(.not.in_block_bd(r_node(:,ibasis,inod,i), new_bd)) then
|
||||
node_out(inod) = .true.
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
!If all nodes are out just add the element to the delete list
|
||||
if(all(node_out)) then
|
||||
delete_num = delete_num +1
|
||||
delete_list(delete_num) = i
|
||||
|
||||
!If any nodes are out we add the element to the delete list, but then loop over the interpoalted atoms to figure out
|
||||
!which ones fit inside the boundary to keep the box rectangular
|
||||
else if (any(node_out)) then
|
||||
delete_num = delete_num +1
|
||||
delete_list(delete_num) = i
|
||||
|
||||
call interpolate_atoms(type_ele(i), size_ele(i), lat_ele(i), r_node(:,:,:,i), type_interp, r_interp)
|
||||
|
||||
!loop over all interpolated atoms and add them to the system
|
||||
do iatom = 1, basisnum(lat_ele(i))*size_ele(i)**3
|
||||
if(in_block_bd(r_interp(:,iatom), new_bd)) then
|
||||
call add_atom(0,type_interp(iatom), sbox_ele(i), r_interp(:,iatom))
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
|
||||
call delete_elements(delete_num, delete_list(1:delete_num))
|
||||
|
||||
print *, "Old box_bd: ", box_bd, " is redefined to new box boundaries: ", new_bd
|
||||
box_bd=new_bd
|
||||
box_bc = new_bc
|
||||
|
||||
end subroutine redef_box
|
||||
|
||||
subroutine parse_redef_box(arg_pos)
|
||||
!Parse the command
|
||||
integer, intent(inout) :: arg_pos
|
||||
|
||||
integer :: i, j, arglen
|
||||
character(len=100) textholder
|
||||
|
||||
|
||||
!First read in the dimensions that we are redefining
|
||||
redef_dim = ''
|
||||
arg_pos=arg_pos+1
|
||||
call get_command_argument(arg_pos, redef_dim, arglen)
|
||||
select case(trim(adjustl(redef_dim)))
|
||||
case('x','y','z','xy','yx','xz','zx','yz','zy','xyz','yxz','xzy','zyx','zxy','yzx')
|
||||
continue
|
||||
case default
|
||||
print *, "Incorrect redef_dim ", redef_dim, "please select any permuation of x, y, z, xy, yz, xz, xyz"
|
||||
stop 3
|
||||
end select
|
||||
|
||||
!Now read in the new dimensions
|
||||
new_bd = box_bd
|
||||
new_bc = box_bc
|
||||
do i = 1, 3
|
||||
select case(trim(adjustl(redef_dim(i:i))))
|
||||
case('x')
|
||||
j = 1
|
||||
case('y')
|
||||
j = 2
|
||||
case('z')
|
||||
j = 3
|
||||
case default
|
||||
exit
|
||||
end select
|
||||
|
||||
arg_pos=arg_pos +1
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if(arglen == 0) stop "Missing a box dimension in opt_redef_box"
|
||||
call parse_pos(j, textholder,new_bd(2*j-1))
|
||||
|
||||
arg_pos=arg_pos +1
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if(arglen == 0) stop "Missing a box dimension in opt_redef_box"
|
||||
call parse_pos(j, textholder,new_bd(2*j))
|
||||
new_bc(j:j) = 's'
|
||||
end do
|
||||
|
||||
arg_pos = arg_pos + 1
|
||||
end subroutine parse_redef_box
|
||||
|
||||
end module opt_redef_box
|
||||
@ -0,0 +1,176 @@
|
||||
module opt_slip_plane
|
||||
use parameters
|
||||
use elements
|
||||
use functions
|
||||
use subroutines
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: sdim
|
||||
real(kind=dp) :: spos
|
||||
logical :: efill
|
||||
|
||||
public
|
||||
contains
|
||||
|
||||
subroutine run_slip_plane(arg_pos)
|
||||
!Main calling function for the slip_plane option
|
||||
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, 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), &
|
||||
maxp, minp
|
||||
|
||||
integer :: type_interp(max_basisnum*max_esize**3)
|
||||
logical :: lat_points(max_esize,max_esize, max_esize)
|
||||
|
||||
|
||||
print *, '---------------------Option Slip_Plane----------------------'
|
||||
|
||||
!Initialize variables
|
||||
efill = .false.
|
||||
slip_enum = 0
|
||||
old_atom_num = atom_num
|
||||
|
||||
!!Parse the argument
|
||||
call parse(arg_pos)
|
||||
|
||||
|
||||
!If we are running the efill code then we have to initiate some variables
|
||||
if(efill) then
|
||||
new_ele_num = 0
|
||||
end if
|
||||
allocate(slip_eles(1024))
|
||||
!Now loop over all elements, find which ones intersect
|
||||
do ie = 1, ele_num
|
||||
if( (spos < maxval(r_node(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)),ie))).and. &
|
||||
(spos > minval(r_node(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie)),ie)))) then
|
||||
slip_enum = slip_enum + 1
|
||||
if (slip_enum > size(slip_eles)) then
|
||||
allocate(temp_int(size(slip_eles)+1024))
|
||||
temp_int(1:size(slip_eles)) = slip_eles
|
||||
temp_int(size(slip_eles)+1:) = 0
|
||||
call move_alloc(temp_int, slip_eles)
|
||||
end if
|
||||
slip_eles(slip_enum) = ie
|
||||
|
||||
!If we aren't efilling then just refine the element
|
||||
if(.not.efill) then
|
||||
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
|
||||
call apply_periodic(r_interp(:,ia))
|
||||
call add_atom(0, type_interp(ia), sbox_ele(ie), r_interp(:,ia))
|
||||
end do
|
||||
!If we are efilling then the code is slightly more complex
|
||||
else
|
||||
!First populate the lat points array
|
||||
lat_points(1:size_ele(ie),1:size_ele(ie), 1:size_ele(ie)) = .true.
|
||||
|
||||
!Now start trying to remesh the region, leaving the slip plane as a discontinuity
|
||||
esize = size_ele(ie) - 2
|
||||
nump_ele = size_ele(ie)**3
|
||||
do while(esize > min_efillsize)
|
||||
if(nump_ele < esize**3) then
|
||||
esize = esize - 2
|
||||
else
|
||||
ele = cubic_cell*(esize -1)
|
||||
do o = 1, size_ele(ie) - esize
|
||||
do n = 1, size_ele(ie) - esize
|
||||
latloop:do m = 1, size_ele(ie) - esize
|
||||
do inod = 1, ng_node(lat_ele(ie))
|
||||
vlat = ele(:,inod) + (/ m, n, o /)
|
||||
if (.not.lat_points(vlat(1), vlat(2),vlat(3))) cycle latloop
|
||||
call get_interp_pos(vlat(1), vlat(2), vlat(3), ie, rfill(:,:,inod))
|
||||
end do
|
||||
|
||||
!Check to make sure all lattice points exist for the current element
|
||||
if(any(.not.lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1))) cycle latloop
|
||||
!Check to see if the plane intersects this element if not then add it
|
||||
maxp = maxval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie))))
|
||||
minp = minval(rfill(sdim,1:basisnum(lat_ele(ie)),1:ng_node(lat_ele(ie))))
|
||||
if(.not.(spos < maxp).and.(spos > minp))then
|
||||
nump_ele = nump_ele - esize**3
|
||||
lat_points(m:m+esize-1, n:n+esize-1, o:o+esize-1) = .false.
|
||||
call add_element(0, type_ele(ie), esize, lat_ele(ie), sbox_ele(ie), rfill)
|
||||
new_ele_num = new_ele_num + 1
|
||||
end if
|
||||
end do latloop
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
esize= esize-2
|
||||
end do
|
||||
! Now add the leftover lattice points as atoms
|
||||
do o = 1, size_ele(ie)
|
||||
do n = 1, size_ele(ie)
|
||||
do m = 1, size_ele(ie)
|
||||
if(lat_points(m,n,o)) then
|
||||
call get_interp_pos(m,n,o, ie, ratom(:,:))
|
||||
do ibasis = 1, basisnum(lat_ele(ie))
|
||||
call apply_periodic(r_atom(:,ibasis))
|
||||
call add_atom(0, basis_type(ibasis,lat_ele(ie)), sbox_ele(ie), ratom(:,ibasis))
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
|
||||
!Once we finish adding elements delete the old ones
|
||||
call delete_elements(slip_enum, slip_eles(1:slip_enum))
|
||||
|
||||
!Output data
|
||||
if(.not.efill) then
|
||||
print *, "We refine ", slip_enum, " elements into ", atom_num - old_atom_num , " atoms"
|
||||
else
|
||||
print *, "We refine ", slip_enum, " elements into ", atom_num - old_atom_num , " atoms and ", new_ele_num, " elements"
|
||||
end if
|
||||
|
||||
end subroutine run_slip_plane
|
||||
|
||||
subroutine parse(arg_pos)
|
||||
!This subroutine parses the input arguments to the mode
|
||||
integer, intent(inout) :: arg_pos
|
||||
|
||||
integer :: arglen
|
||||
character(len = 100) :: textholder
|
||||
|
||||
!First read the dimension
|
||||
arg_pos = arg_pos +1
|
||||
call get_command_argument(arg_pos,textholder, arglen)
|
||||
if(arglen == 0) stop "Incorrect slip_plane command. Please check documentation for correct format"
|
||||
|
||||
!Check to make sure that the dimension is correct
|
||||
select case(trim(adjustl(textholder)))
|
||||
case('x','X')
|
||||
sdim = 1
|
||||
case('y','Y')
|
||||
sdim = 2
|
||||
case('z','Z')
|
||||
sdim = 3
|
||||
case default
|
||||
print *, "Error: dimension ", trim(adjustl(textholder)), " is not accepted. Please select from x, y, or z"
|
||||
end select
|
||||
|
||||
!Now parse the position of the slip plane
|
||||
arg_pos = arg_pos + 1
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if(arglen == 0) stop "Incorrect slip_plane command. Please check documentation for correct format"
|
||||
call parse_pos(sdim, textholder, spos)
|
||||
|
||||
!Now check to see if efill was passed
|
||||
arg_pos = arg_pos + 1
|
||||
if(.not.(arg_pos > command_argument_count())) then
|
||||
call get_command_argument(arg_pos, textholder, arglen)
|
||||
if(arglen == 0) stop "Incorrect slip_plane command. Please check documentation for correct format"
|
||||
if(trim(adjustl(textholder)) == "efill") then
|
||||
arg_pos = arg_pos +1
|
||||
efill = .true.
|
||||
end if
|
||||
end if
|
||||
end subroutine parse
|
||||
end module opt_slip_plane
|
||||
@ -0,0 +1,33 @@
|
||||
module str
|
||||
|
||||
!this module has some string manipulation commands
|
||||
public
|
||||
contains
|
||||
|
||||
pure function tok_count(text)
|
||||
!counts number of tokens in a string
|
||||
character(len = *), intent(in) :: text
|
||||
integer :: tok_count
|
||||
integer :: i, j
|
||||
logical :: in_tok
|
||||
|
||||
j = len(trim(adjustl(text)))
|
||||
in_tok = .false.
|
||||
tok_count = 0
|
||||
do i = 1, j
|
||||
!This checks if it is a white space character which is the delimiter
|
||||
if(trim(adjustl(text(i:i))) == ' ') then
|
||||
!If previously we were in token and the current character is the delimiter
|
||||
!Then we are no longer in the token
|
||||
if(in_tok) in_tok = .false.
|
||||
|
||||
!If the character isn't a white space character and we previously weren't in the token then set in_tok
|
||||
!to true and increment token count
|
||||
else if(.not.in_tok) then
|
||||
in_tok = .true.
|
||||
tok_count = tok_count + 1
|
||||
end if
|
||||
end do
|
||||
return
|
||||
end function tok_count
|
||||
end module str
|
||||
Loading…
Reference in new issue