Alex Selimov
4 years ago
commit
4dcaddb2cb
@ -0,0 +1,247 @@
|
||||
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(3,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")
|
||||
continue
|
||||
case default
|
||||
print *, "Mode metric does not accept metric ", metric_type, ". Please select from: microrotation"
|
||||
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)
|
||||
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
|
||||
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 x y z F11 F12 F13 F21 F22 F23 F31 F32 F33"
|
||||
case('microrotation')
|
||||
write(11,*) "type x y z micro1 micro2 micro3"
|
||||
end select
|
||||
|
||||
if(atom_num > 0) then
|
||||
do i = 1, atom_num
|
||||
write(11,*) type_atom(i), 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)), 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
|
||||
Loading…
Reference in new issue