Files
lammps/lib/mesont/TPMForceField.f90
2021-05-24 15:53:44 -04:00

317 lines
16 KiB
Fortran

! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! https://www.lammps.org/ Sandia National Laboratories
! Steve Plimpton, sjplimp@sandia.gov
!
! Copyright (2003) Sandia Corporation. Under the terms of Contract
! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
! certain rights in this software. This software is distributed under
! the GNU General Public License.
!
! See the README file in the top-level LAMMPS directory.
!
! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu
!-------------------------------------------------------------------------
module TPMForceField !******************************************************************************
!
! Calculation of the TMD force field
!
!---------------------------------------------------------------------------------------------------
!
! PGI Fortran, Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, version 09.01, 2020
!
!***************************************************************************************************
use CNTPot
use TPMM0
use TPMM1
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
subroutine TubeStretchingForceField ( U1, U2, F1, F2, S1, S2, X1, X2, R12, L12 ) !!!!!!!!!!!
! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout) :: U1, U2
! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2) :: F1, F2
! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2
! Coordinates of the segment nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2
! Radius of a nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R12
! Equilibrium length of segment (X1,X2)
real(c_double), intent(in) :: L12
!-------------------------------------------------------------------------------------------
integer(c_int) :: ii, jj, Event
real(c_double) :: U, F, LL, S, Ubcl
real(c_double), dimension(0:2) :: DX, FF
!-------------------------------------------------------------------------------------------
DX = X2 - X1
LL = S_V3norm3 ( DX )
Event = CNTSTRCalc ( U, F, LL, R12, L12, 0, Ubcl )
U = U / 2.0d+00
FF = DX * F / LL
F1 = F1 + FF
U1 = U1 + U
F2 = F2 - FF
U2 = U2 + U
! Stress
do ii = 0, 2
do jj = 0, 2
S = - 0.5d+00 * DX(ii) * FF(jj)
S1(ii,jj) = S1(ii,jj) + S
S2(ii,jj) = S2(ii,jj) + S
end do
end do
end subroutine TubeStretchingForceField !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TubeBendingForceField ( U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2 )
! Interaction energies associated with nodes X1, X2, and X3
real(c_double), intent(inout) :: U1, U2, U3
! Forces exerted on nodes X1, X2, and X3
real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3
! Contributions of nodes X1, X2, and X3 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3
! Coordinates of nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2, X3
! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R123
! Equilibrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments)
real(c_double), intent(in) :: L123
integer(c_int), intent(inout) :: BBF2
!-------------------------------------------------------------------------------------------
integer(c_int) :: ii, jj, Event
real(c_double) :: U, F, K, S, Ubcl
real(c_double), dimension(0:2) :: G0, G1, G2
!-------------------------------------------------------------------------------------------
call BendingGradients ( K, G0, G1, G2, X1, X2, X3 )
Event = CNTBNDCalc ( U, F, K, R123, L123, BBF2, Ubcl )
if ( Event == CNTPOT_BBUCKLING ) then
BBF2 = 1
else
BBF2 = 0
end if
U = U / 4.0d+00
F = - F
F1 = F1 + G0 * F
F2 = F2 + G1 * F
F3 = F3 + G2 * F
U1 = U1 + U
U2 = U2 + 2.0d+00 * U
U3 = U3 + U
! Stress
do ii = 0, 2
do jj = 0, 2
S = 0.5d+00 * ( X1(ii) - X2(ii) ) * G0(jj)
S1(ii,jj) = S1(ii,jj) + S
S2(ii,jj) = S2(ii,jj) + S
S = 0.5d+00 * ( X3(ii) - X2(ii) ) * G2(jj)
S3(ii,jj) = S3(ii,jj) + S
S2(ii,jj) = S2(ii,jj) + S
end do
end do
end subroutine TubeBendingForceField !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The purpose of subroutine SegmentTubeForceField is to calculate interaction forces
! (as well potential energies and components of the virial stress tensor) between a segment
! (X1,X2) and a sequence of segments which belongs to a single CNT.
! It is assumed that X contains ALL nodes of a single CNT that are included into the
! neighbor list of segment (X1,X2).
! The nodes in X are assumed to be ordered according to their physical appearance in the nanotube.
! It means that (X(i),X(i+1)) are either correspond to a real segment or divided by segments
! that do not belong to a nanotube.
! Concept of the extended chain:
! Let's consider a sequence of nodes (X1,X2,...,XN) forming continuous part of a nanotube.
! If node Xe precedes X1 and Xe is the nanotube end, then the extended chain is (Xe,X1,...,XN) and Ee = 1.
! If node Xe follows XN and Xe is the nanotube end, then the extended chain is (X1,...,XN,Xe) and Ee = 2.
! In all other cases, the extended chain coincides with (X1,...,XN) and Ee = 0.
! If the extended chain contains additional node, then non-zero force is exerted on this node.
subroutine SegmentTubeForceField ( U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe,&
BBF, R, E1, E2, Ee, TPMType )
! Number of nodes in array X
integer(c_int), intent(in) :: N
! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout) :: U1, U2
! Interaction energies associated with nodes X
real(c_double), intent(inout), dimension(0:N-1) :: U
! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2) :: F1, F2
! Forces exerted on nodes X
real(c_double), intent(inout), dimension(0:2,0:N-1) :: F
! Force exerted on node Xe (can be updated only if Ee > 0)
real(c_double), intent(inout), dimension(0:2) :: Fe
! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2
! Contributions of nodes X to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S
! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0)
real(c_double), intent(inout), dimension(0:2,0:2) :: Se
! Coordinates of the segment nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2
! Radius of a nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R12
! Coordinates of the nanotube nodes
real(c_double), intent(in), dimension(0:2,0:N-1) :: X
! Additional node of the extended chain if Ee > 0
real(c_double), intent(in), dimension(0:2) :: Xe
! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i)
integer(c_int), intent(in), dimension(0:N-1) :: BBF
! Radius of nanotube X
real(c_double), intent(in) :: R
! E1 = 1 if the chain node 0 is a CNT end; E1 = 2 if the chain node N-1 is a CNT end
integer(c_int), intent(in) :: E1, E2
! Parameter defining the type of the extended chain (0,1,2)
integer(c_int), intent(in) :: Ee
! Type of the tubular potential (0 or 1)
integer(c_int), intent(in) :: TPMType
!-------------------------------------------------------------------------------------------
integer(c_int) :: k, ii, jj, IntSign
integer(c_int) :: BType, EType, LocalTPMType
real(c_double), dimension(0:2,0:N-1) :: G1, G2
real(c_double), dimension(0:N-1) :: QQ
logical :: EType1, EType2
real(c_double), dimension(0:2) :: G, DG, DQ, XX
real(c_double) :: UT, DR, DS, DS1
! Interaction energies associated with nodes X1 and X2
real(c_double) :: xU1, xU2
! Interaction energies associated with nodes X
real(c_double), dimension(0:N-1) :: xU
! Forces exerted on nodes X1 and X2
real(c_double), dimension(0:2) :: xF1, xF2
! Forces exerted on nodes X
real(c_double), dimension(0:2,0:N-1) :: xF
! Force exerted on node Xe (can be updated only if Ee > 0)
real(c_double), dimension(0:2) :: xFe
!-------------------------------------------------------------------------------------------
! Looking for a buckling point
BType = 0
do k = 0, N - 1
if ( BBF(k) == 1 ) then
BType = 1
exit
end if
end do
! Choosing the LocalTPMType and Etype.
! LocalTPMType is set to 0 if both ends of the chain are nanotube ends or the chain contains a buckling point.
! Overwise, LocalTPMType = TPMType.
if ( BType == 1 ) then
LocalTPMType = 0
EType = 0
else
if ( E1 == 1 ) then ! The first node in the chain is the tube end
EType1 = .true.
else
EType1 = .false.
end if
if ( E2 == 1 ) then ! The last node in the chain is the tube end
EType2 = .true.
else
EType2 = .false.
end if
if ( EType1 .and. EType2 ) then
LocalTPMType = 0
else
LocalTPMType = TPMType
if ( EType1 ) then
EType = 1
else if ( EType2 ) then
EType = 2
else ! No tube ends in the chain
EType = 0
end if
end if
end if
if ( LocalTPMType == 0 ) then
IntSign = TPMInteractionFW0 ( QQ, UT, xU1, xU2, xU, xF1, xF2, xF, G1, G2, X1, X2, N, N, X )
else
if ( EType == 0 ) then
if ( Ee == 1 ) then ! The first node in the extended chain is the tube end
EType = 3
else if ( Ee == 2 ) then ! The last node in the extended chain is the tube end
EType = 4
end if
end if
IntSign = TPMInteractionFW1 ( QQ, UT, xU1, xU2, xU, xF1, xF2, xF, xFe, G1, G2, X1, X2, N, N, X, Xe, EType )
end if
if ( IntSign == 0 ) return ! No interaction
! Final potential energies
U1 = U1 + 0.5d+00 * xU1
U2 = U2 + 0.5d+00 * xU2
U(0:N-1) = U(0:N-1) + 0.5d+00 * xU(0:N-1)
! Contributions to the virial stresses tensor
do ii = 0, 2
DR = 0.125d+00 * ( X2(ii) - X1(ii) )
do jj = 0, 2
DS = DR * ( xF2(jj) - xF1(jj) )
S1(ii,jj) = S1(ii,jj) + DS
S2(ii,jj) = S2(ii,jj) + DS
end do
end do
XX = 0.5d+00 * ( X2 + X1 )
if ( EType > 2 ) then
DQ = Xe - XX
call ApplyPeriodicBC ( DQ )
DQ = DQ / 6.0d+00
do ii = 0, 2
do jj = 0, 2
DS = DQ(ii) * xFe(jj)
S1(ii,jj) = S1(ii,jj) + DS
S2(ii,jj) = S1(ii,jj) + DS
Se(ii,jj) = Se(ii,jj) + DS
end do
end do
end if
do k = 0, N - 2
DQ = 0.5d+00 * ( X(0:2,k+1) + X(0:2,k) ) - XX
call ApplyPeriodicBC ( DQ )
DQ = 0.125d+00 * DQ
G = G1(0:2,k+1) + G2(0:2,k)
DG = G1(0:2,k+1) - G2(0:2,k)
do ii = 0, 2
DR = 0.125d+00 * ( X(ii,k+1) - X(ii,k) )
do jj = 0, 2
DS = DQ(ii) * G(jj)
DS1 = DS + DR * DG(jj)
S1(ii,jj) = S1(ii,jj) + DS
S2(ii,jj) = S2(ii,jj) + DS
S(ii,jj,k) = S(ii,jj,k) + DS1
S(ii,jj,k+1) = S(ii,jj,k+1) + DS1
end do
end do
end do
! Final forces
F1 = F1 + 0.5d+00 * xF1
F2 = F2 + 0.5d+00 * xF2
F(0:2,0:N-1) = F(0:2,0:N-1) + 0.5d+00 * xF(0:2,0:N-1)
if ( EType > 2 ) then
Fe = Fe + 0.5d+00 * xFe
end if
end subroutine SegmentTubeForceField !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TPMForceField !**************************************************************************