You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
250 lines
8.8 KiB
250 lines
8.8 KiB
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
|