ICODE-ADC/lammps
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

update

Browse Source
This commit is contained in:
iafoss
2020-05-18 17:28:48 -04:00
parent be93ef7b20
commit e26be18b1e
66 changed files with 3277 additions and 3532 deletions
Download Patch File Download Diff File Expand all files Collapse all files

734
tools/mesont/CNTPot.f90
View File

@ -1,734 +0,0 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 CNTPot !*************************************************************************************
!
! TMD Library: Mesoscopic potential for internal modes in CNTs
!
!---------------------------------------------------------------------------------------------------
!
! Implementation of carbon nanotubes internal potentials:
! CNTSTRH0, harmonic stretching potential of type 0 with constant Young's modulus
! CNTSTRH1, harmonic stretching potential of type 1 with variable Youngs modulus
! CNTSTRNH0, non-harmonic stretching with fracture potential of type 0
! CNTSTRNH1, non-harmonic stretching with fracture potential of type 1
! CNTBNDH, harmonic bending potential
! CNTBNDHB, harmonic bending-buckling potential
! CNTBNDHBF, harmonic bending-buckling potential with fracture
! CNTTRS, torsion potential
! CNTBRT, breathing potential
!
! The functional form and force constants of harmonic streatching, bending and
! torsion potentials are taken from:
! L.V. Zhigilei, Ch. Wei, D. Srivastava, Phys. Rev. B 71, 165417 (2005)
!
! The model of stress-strain curve for non-harmonic potential with fracture
! is developed and parameterized with the help of constant
! -- Young's modulus (Pa),
! -- maximal linear strain (only for the NH potential of type 1)
! -- tensile strength (or fracture strain, Pa),
! -- strain at failure (or fracture strain)
! -- maximal strain.
! All these parameters are assumed to be independent of SWCNT radius or type.
! In this model true strain at failure CNTSTREft and true tensile strength
! CNTSTRSft are slightly different from imposed values CNTSTREf and CNTSTRSf.
! This difference is really small and is not taken into account.
!
! The non-harmonic stretching potentials of types 0 and 1 are different from
! each other by the functional form of the stress-strain curve
!
! Different parameterizations of CNTSTRH0, CNTSTRNH0 and CNTSTRNH1 potentials
! can be chosen, see subroutine CNTSTRSetParameterization
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 08.02.m.m.2.m, 2017
!
!***************************************************************************************************
use TPMLib
use iso_c_binding, only : c_int, c_double, c_char
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
integer(c_int), parameter :: CNTPOT_STRETCHING = 0
integer(c_int), parameter :: CNTPOT_SBUCKLING = 1
integer(c_int), parameter :: CNTPOT_SFRACTURE = 2
integer(c_int), parameter :: CNTPOT_BENDING = 3
integer(c_int), parameter :: CNTPOT_BBUCKLING = 4
integer(c_int), parameter :: CNTPOT_BFRACTURE = 5
integer(c_int), parameter :: CNTSTRMODEL_H0 = 0 ! Harmonic stetching model (constant Young's modulus)
integer(c_int), parameter :: CNTSTRMODEL_H1 = 1 ! Harmonic stretching model (Young's modulus depends on radius)
integer(c_int), parameter :: CNTSTRMODEL_NH0F = 2 ! Non-harmonic stretching with fracture, potential of type 0
integer(c_int), parameter :: CNTSTRMODEL_NH1 = 3 ! Non-harmonic stretching without fracture, potential of type 1
integer(c_int), parameter :: CNTSTRMODEL_NH1F = 4 ! Non-harmonic stretching with fracture, potential of type 1
integer(c_int), parameter :: CNTSTRMODEL_H1B = 5 ! Harmonic stetching model + axial buckling
integer(c_int), parameter :: CNTSTRMODEL_H1BH = 6 ! Harmonic stetching model + axial buckling + hysteresis
integer(c_int), parameter :: CNTBNDMODEL_H = 0 ! Harmonic bending model
integer(c_int), parameter :: CNTBNDMODEL_HB = 1 ! Harmonic bending - buckling model
integer(c_int), parameter :: CNTBNDMODEL_HBF = 2 ! Harmonic bending - buckling - fracture model
integer(c_int), parameter :: CNTBNDMODEL_HBH = 3 ! Harmonic bending - buckling + Hysteresis
integer(c_int), parameter :: CNTPOTNMAX = 4000 ! Maximal number of points in interpolation tables
!---------------------------------------------------------------------------------------------------
! Parameters of potentials
!---------------------------------------------------------------------------------------------------
! Stretching potential
integer(c_int) :: CNTSTRModel = CNTSTRMODEL_H1! Type of the bending model
integer(c_int) :: CNTSTRParams = 0 ! Type of parameterization
integer(c_int) :: CNTSTRYMT = 0 ! Type of dependence of the Young's modulus on tube radius
! Parameters of non-harmonic potential and fracture model
real(c_double) :: CNTSTRR0 = 6.8d+00 ! Reference radius of nanotubes, A
! (this parameter is not used for the model
! paramerization, but only for calcuation of the
! force constant in eV/A)
real(c_double) :: CNTSTRD0 = 3.4d+00 ! CNT wall thickness (diameter of carbon atom), A
real(c_double) :: CNTSTREmin = -0.4d+00 ! Minimal strain in tabulated potential
real(c_double) :: CNTSTREmax = 0.13d+00 ! Maximal strain in tabulated potential. Simultaneously, U=0 if E> CNTSTREmax
real(c_double) :: CNTSTREl = 5.0d-02 ! Maximal linear strain
real(c_double) :: CNTSTREf = 12.0d-02 ! Strain at failure
real(c_double) :: CNTSTRS0 = 0.850e+12 ! Young's modulus, Pa
real(c_double) :: CNTSTRSl ! Maximal linear strees, Pa
real(c_double) :: CNTSTRSf = 75.0d+09 ! Tensile strength, Pa
real(c_double) :: CNTSTRF0 ! Elastic force constant, eV/A**2
real(c_double) :: CNTSTRFl ! Maximal linear force, eV/A**2
real(c_double) :: CNTSTRFf ! Tensile force at failure, eV/A**2
real(c_double) :: CNTSTRSi ! Maximal available stress (reference parameter, not used in the model), Pa
real(c_double) :: CNTSTRDf ! dF/dE at failure
real(c_double) :: CNTSTRAA, CNTSTRBB !
real(c_double) :: CNTSTRAAA, CNTSTRBBB ! | Auxilary constants
real(c_double) :: CNTSTRUl, CNTSTRUf ! /
! Axial buckling - hysteresis approch
real(c_double) :: CNTSTREc = -0.0142d+00 ! The minimal buckling strain
real(c_double) :: CNTSTREc1 = -0.04d+00 ! Critical axial buckling strain
real(c_double) :: CNTSTREc2 = -0.45d+00 ! Maximal buckling strain (the pot is harmonic for larger strains(in abs val))
!real(c_double) :: CNTSTRAmin
!real(c_double) :: CNTSTRAmax
!real(c_double) :: CNTSTRDA
! Bending potential
integer(c_int) :: CNTBNDModel = CNTBNDMODEL_H ! Type of the bending model
!real(c_double) :: CNTBNDAmin
!real(c_double) :: CNTBNDAmax
!real(c_double) :: CNTBNDDA
! Buckling model parameters
real(c_double) :: CNTBNDN = 1.0d+00 ! Buckling exponent
real(c_double) :: CNTBNDB = 0.68d+00 ! Buckling number
real(c_double) :: CNTBNDR = 275.0d+00 ! Critical radius of curvarure, A
! This is mean value for (10,10) SWCNT
real(c_double) :: CNTBNDTF = M_PI * 120.0d+00 / 180.0d+00 ! Fracture buckling angle, rad
real(c_double) :: CNTBNDN1
real(c_double) :: CNTBNDC2
contains !******************************************************************************************
!---------------------------------------------------------------------------------------------------
! Stretching potential
!---------------------------------------------------------------------------------------------------
subroutine CNTSTRSetParameterization ( PType ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Setup parameters for further parameterization of streatching models
! References:
! [1] Yu M.-F. et al., Phys. Rev. Lett. 84(24), 5552 (2000)
! [2] Liew K.M. et al., Acta Materialia 52, 2521 (2004)
! [3] Mielke S.L. et al., Chem. Phys. Lett. 390, 413 (2004)
! [4] Zhigilei L.V. et al., Phys. Rev. B 71, 165417 (2005)
! [5] Kelly B.T., Physics of graphite, 1981
!-------------------------------------------------------------------------------------------
integer(c_int), intent(in) :: PType
!-------------------------------------------------------------------------------------------
select case ( PType )
case ( 0 ) ! This parametrization is based on averaged exp. data of Ref. [1]
CNTSTRR0 = 6.8d+00 ! Ref. [1]
CNTSTRD0 = 3.4d+00 ! Ref. [1]
CNTSTREmin = -0.4d+00 ! Chosen arbitrary
CNTSTREmax = 3.64d-02 ! = CNTSTREf + 0.005
CNTSTREl = 2.0d-02 ! Chosen arbitrary
CNTSTREf = 3.14d-02 ! Ref. [1]
CNTSTRS0 = 1.002e+12 ! Ref. [1]
CNTSTRSf = 30.0d+09 ! Ref. [1]
case ( 1 ) ! This parameterization is taken from Ref. [2] for (10,10) SWCNT
! These values are obtained in MD simulatuions with REBO potential
! Values of Young's modulus, Tensile strenght and stress here
! are close to those obtained in Ref. [3] for pristine (defectless)
! (5,5) SWCNT in semiempirical QM calcuilations based on PM3 model
CNTSTRR0 = 6.785d+00 ! Calculated with usual formula for (10,10) CNT
CNTSTRD0 = 3.35d+00 ! Ref. [2]
CNTSTREmin = -0.4d+00 ! Chosen arbitrary
CNTSTREmax = 28.4d-02 ! = CNTSTREf + 0.005
CNTSTREl = 5.94d-02 ! Ref. [2]
CNTSTREf = 27.9d-02 ! Corresponds to Maximal strain in Ref. [2]
CNTSTRS0 = 1.031e+12 ! Ref. [2]
CNTSTRSf = 148.5d+09 ! Corresponds to Tensile strength in Ref. [2]
case ( 2 ) ! This parametrization is taken from Ref. [3] for (5,5) SWCNT
! with one atom vacancy defect obtained by semiempirical QM PM3 model
CNTSTRR0 = 3.43d+00 ! Ref. [3]
CNTSTRD0 = 3.4d+00 ! Ref. [3]
CNTSTREmin = -0.4d+00 ! Chosen arbitrary
CNTSTREmax = 15.8d-02 ! = CNTSTREf + 0.005
CNTSTREl = 6.00d-02 ! Chosed similar to Ref. [2]
CNTSTREf = 15.3d-02 ! Ref. [3]
CNTSTRS0 = 1.100e+12 ! Ref. [3]
CNTSTRSf = 100.0d+09 ! Ref. [3]
case ( 3 ) ! This special parameterization changes the only value of Young's modulus
! with accordance with the stretching constant in Ref. [4]
CNTSTRS0 = ( 86.64d+00 + 100.56d+00 * CNTSTRR0 ) * K_MDFU / ( M_2PI * CNTSTRR0 * CNTSTRD0 * 1.0e-20 ) ! Ref. [4]
case ( 4 ) ! This special parameterization changes the only value of Young's modulus
! making it equal to the in-plane Young's modulus of graphite
CNTSTRR0 = 6.785d+00 ! Calculated with usual formula for (10,10) CNT
CNTSTRD0 = 3.4d+00 ! Ref. [1]
CNTSTRS0 = 1.06e+12 ! Ref. [5]
end select
end subroutine CNTSTRSetParameterization !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Stretching without fracture, harmonic potential
!
integer(c_int) function CNTSTRH0Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus is independent of R
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: U, dUdL
real(c_double), intent(in) :: L, R0, L0
real(c_double) :: E
!-------------------------------------------------------------------------------------------
E = ( L - L0 ) / L0
dUdL = R0 * CNTSTRF0 * E
U = 0.5d+00 * L0 * E * dUdL
CNTSTRH0Calc = CNTPOT_STRETCHING
end function CNTSTRH0Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTSTRH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus depends on R, see [4]
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: U, dUdL
real(c_double), intent(in) :: L, R0, L0
real(c_double) :: E, K
!-------------------------------------------------------------------------------------------
E = ( L - L0 ) / L0
K = 86.64d+00 + 100.56d+00 * R0
dUdL = K * E
U = 0.5d+00 * L0 * E * dUdL
CNTSTRH1Calc = CNTPOT_STRETCHING
end function CNTSTRH1Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Stretching without fracture, harmonic potential, with axial buckling without hysteresis
!
integer(c_int) function CNTSTRH1BCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus depends on R, see [4]
! Axial buckling without hysteresis
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: U, dUdL
real(c_double), intent(in) :: L, R0, L0
real(c_double) :: E, K, Kbcl, dUbcl, d, ud
!-------------------------------------------------------------------------------------------
E = ( L - L0 ) / L0
K = 86.64d+00 + 100.56d+00 * R0
Kbcl = -10.98d+00 * L0
if ( E .gt. CNTSTREc ) then !Harmonic stretching
dUdL = K * E
U = 0.5d+00 * L0 * E * dUdL
CNTSTRH1BCalc = CNTPOT_STRETCHING
else if ( E .gt. CNTSTREc2 ) then !Axial buckling
dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc
U = Kbcl * E + dUbcl
dUdL = Kbcl / L0
CNTSTRH1BCalc = CNTPOT_STRETCHING !should be buckling, but doesn't work for some reason...
else !Return to harmonic potential
d = -0.0142794
dUdL = K * ( d + E - CNTSTREc2 )
dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc + Kbcl * CNTSTREc2
Ud = 0.5d+00 * L0 * K * d * d
U = 0.5d+00 * L0 * (d+E-CNTSTREc2) * dUdL + dUbcl - Ud
CNTSTRH1BCalc = CNTPOT_STRETCHING
end if
end function CNTSTRH1BCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Stretching without fracture, harmonic potential, with axial buckling with hysteresis
!
integer(c_int) function CNTSTRH1BHCalc ( U, dUdL, L, R0, L0, ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus depends on R, see [4]
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: U, dUdL, Ebuc
real(c_double), intent(in) :: L, R0, L0
integer(c_int), intent(in) :: ABF
!-------------------------------------------------------------------------------------------
real(c_double) :: E, K, dUbcl, Ebcl, Kbcl, Edu
real(c_double) :: C, DE, t
!-------------------------------------------------------------------------------------------
E = ( L - L0 ) / L0
K = 86.64d+00 + 100.56d+00 * R0
Kbcl = -10.98d+00 * L0
if ( E .gt. CNTSTREc ) then ! harmonic potential - no buckling
dUdL = K * E
U = 0.5d+00 * L0 * E * dUdL
CNTSTRH1BHCalc = CNTPOT_STRETCHING
Ebuc = 0.0d+00
else if ( E .gt. CNTSTREc1 ) then !above minimal buckling strain, but not at critical strain
if ( ABF .eq. 0 ) then ! not buckled. Continue harmonic potential
dUdL = K * E
U = 0.5d+00 * L0 * E * dUdL
CNTSTRH1BHCalc = CNTPOT_STRETCHING
Ebuc = 0.0d+00
else ! relaxing from buckled state. Use buckling potential
dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc
U = Kbcl * E + dUbcl
dUdL = Kbcl / L0
CNTSTRH1BHCalc = CNTPOT_SBUCKLING
Ebuc = 0.0d+00
end if
else if( E .gt. CNTSTREc2 ) then ! Axial buckling strain region
if ( ABF .eq. 0 ) then !newly buckled
dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc
U = Kbcl * E + dUbcl
dUdL = Kbcl / L0
CNTSTRH1BHCalc = CNTPOT_SBUCKLING
Ebuc = 0.5d+00 * L0 * K * CNTSTREc1 * CNTSTREc1 - Kbcl * CNTSTREc1 - dUbcl
else ! already buckled
dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc
U = Kbcl * E + dUbcl
dUdL = Kbcl / L0
CNTSTRH1BHCalc = CNTPOT_SBUCKLING
Ebuc = 0.0d+00
end if
else ! Maximum strain and return to harmonic potential
dUdL = K * E
U = 0.5d+00 * L0 * E * dUdL
CNTSTRH1BHCalc = CNTPOT_STRETCHING
Ebuc = 0.0d+00
end if
end function CNTSTRH1BHCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Stretching with fracture, non-harmonic potential of type 0
!
integer(c_int) function CNTSTRNH0FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: U, dUdL
real(c_double), intent(in) :: L, R0, L0
real(c_double) :: E, DE, t
!-------------------------------------------------------------------------------------------
E = ( L - L0 ) / L0
if ( E < CNTSTREf ) then
dUdL = ( CNTSTRAA - CNTSTRBB * E ) * E
U = ( CNTSTRAAA - CNTSTRBBB * E ) * E * E
CNTSTRNH0FCalc = CNTPOT_STRETCHING
else
dUdL = 0.0d+00
U = 0.0d+00
CNTSTRNH0FCalc = CNTPOT_SFRACTURE
end if
U = L0 * R0 * U
dUdL = R0 * dUdL
end function CNTSTRNH0FCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CNTSTRNH0Init () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) :: S
!-------------------------------------------------------------------------------------------
S = M_2PI * CNTSTRD0 * 1.0e-20 / K_MDFU
CNTSTRSl = CNTSTRS0 * CNTSTREl
CNTSTRF0 = CNTSTRS0 * S
CNTSTRFl = CNTSTRSl * S
CNTSTRFf = CNTSTRSf * S
CNTSTRAA = CNTSTRF0
CNTSTRBB = ( CNTSTRF0 * CNTSTREf - CNTSTRFf ) / ( CNTSTREf * CNTSTREf )
CNTSTRAAA= CNTSTRAA / 2.0d+00
CNTSTRBBB= CNTSTRAA / 3.0d+00
CNTSTRUl = 0.0d+00
CNTSTRUf = ( CNTSTRAAA - CNTSTRBBB * CNTSTREf ) * CNTSTREf * CNTSTREf
! These two values are not defined yet
CNTSTRSi = 0.0d+00
CNTSTRDf = 0.0d+00
end subroutine CNTSTRNH0Init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Stretching without fracture, non-harmonic potential of type 1
!
integer(c_int) function CNTSTRNH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: U, dUdL
real(c_double), intent(in) :: L, R0, L0
real(c_double) :: E, C, DE, t
!-------------------------------------------------------------------------------------------
E = ( L - L0 ) / L0
if ( E < CNTSTREl ) then
dUdL = CNTSTRF0 * E
U = 0.5d+00 * E * dUdL
CNTSTRNH1Calc = CNTPOT_STRETCHING
else
DE = E - CNTSTREl
C = 1.0 + CNTSTRBB * DE
dUdL = CNTSTRFl + CNTSTRAA * ( 1.0d+00 - 1.0d+00 / C )
U = CNTSTRUl + CNTSTRAAA * DE - CNTSTRBBB * dlog ( C )
end if
CNTSTRNH1Calc = CNTPOT_STRETCHING
U = L0 * R0 * U
dUdL = R0 * dUdL
end function CNTSTRNH1Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Stretching with fracture, non-harmonic potential of type 1
!
integer(c_int) function CNTSTRNH1FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: U, dUdL
real(c_double), intent(in) :: L, R0, L0
real(c_double) :: E, C, DE, t
!character(c_char)*512 :: Msg
!-------------------------------------------------------------------------------------------
E = ( L - L0 ) / L0
if ( E < CNTSTREl ) then
dUdL = CNTSTRF0 * E
U = 0.5d+00 * E * dUdL
CNTSTRNH1FCalc = CNTPOT_STRETCHING
else if ( E < CNTSTREf ) then
DE = E - CNTSTREl
C = 1.0 + CNTSTRBB * DE
dUdL = CNTSTRFl + CNTSTRAA * ( 1.0d+00 - 1.0d+00 / C )
U = CNTSTRUl + CNTSTRAAA * DE - CNTSTRBBB * dlog ( C )
CNTSTRNH1FCalc = CNTPOT_STRETCHING
else
!write ( Msg, * ) 'F Strains', E, CNTSTREf
!call PrintStdLogMsg ( Msg )
dUdL = 0.0d+00
U = 0.0d+00
CNTSTRNH1FCalc = CNTPOT_SFRACTURE
end if
U = L0 * R0 * U
dUdL = R0 * dUdL
end function CNTSTRNH1FCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CNTSTRNH1Init () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) :: S, C, E, t
integer(c_int) :: i, CaseID
!-------------------------------------------------------------------------------------------
S = M_2PI * CNTSTRD0 * 1.0e-20 / K_MDFU
CNTSTRSl = CNTSTRS0 * CNTSTREl
CNTSTRF0 = CNTSTRS0 * S
CNTSTRFl = CNTSTRSl * S
CNTSTRFf = CNTSTRSf * S
CNTSTRAA = ( CNTSTRFf - CNTSTRFl ) * ( CNTSTREf * CNTSTRF0 - CNTSTRFl ) / ( CNTSTREf * CNTSTRF0 - CNTSTRFf )
CNTSTRBB = CNTSTRF0 / CNTSTRAA
CNTSTRAAA= CNTSTRFl + CNTSTRAA
CNTSTRBBB= CNTSTRAA / CNTSTRBB
CNTSTRSi = CNTSTRSl + CNTSTRAA / S
C = 1.0 + CNTSTRBB * ( CNTSTREf - CNTSTREl )
CNTSTRDf = CNTSTRF0 / C / C
CNTSTRUl = 0.5d+00 * CNTSTRFl * CNTSTREl
CNTSTRUf = CNTSTRUl + ( CNTSTRFl + CNTSTRAA ) * ( CNTSTREf - CNTSTREl ) - CNTSTRAA * dlog ( C ) / CNTSTRBB
end subroutine CNTSTRNH1Init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! General
!
!integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 , ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: U, dUdL, Ebuc
real(c_double), intent(in) :: L, R0, L0
integer(c_int), intent(in) :: ABF
!-------------------------------------------------------------------------------------------
Ebuc = 0.0d+00
select case ( CNTSTRModel )
case ( CNTSTRMODEL_H0 )
CNTSTRCalc = CNTSTRH0Calc ( U, dUdL, L, R0, L0 )
case ( CNTSTRMODEL_H1 )
CNTSTRCalc = CNTSTRH1Calc ( U, dUdL, L, R0, L0 )
case ( CNTSTRMODEL_NH0F )
CNTSTRCalc = CNTSTRNH0FCalc ( U, dUdL, L, R0, L0 )
case ( CNTSTRMODEL_NH1 )
CNTSTRCalc = CNTSTRNH1Calc ( U, dUdL, L, R0, L0 )
case ( CNTSTRMODEL_NH1F )
CNTSTRCalc = CNTSTRNH1FCalc ( U, dUdL, L, R0, L0 )
case ( CNTSTRMODEL_H1B )
CNTSTRCalc = CNTSTRH1BCalc ( U, dUdL, L, R0, L0 )
case ( CNTSTRMODEL_H1BH )
CNTSTRCalc = CNTSTRH1BHCalc ( U, dUdL, L, R0, L0, ABF, Ebuc )
end select
end function CNTSTRCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CNTSTRInit ( STRModel, STRParams, YMType, Rref ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: STRModel, STRParams, YMType
real(c_double), intent(in) :: Rref
!real(c_double) :: A
!integer(c_int) :: i
!-------------------------------------------------------------------------------------------
CNTSTRModel = STRModel
CNTSTRParams = STRParams
CNTSTRYMT = YMType
if ( STRModel .ne. CNTSTRMODEL_H1 ) then
call CNTSTRSetParameterization ( STRParams )
if ( YMType == 2 ) then
call CNTSTRSetParameterization ( 4 )
else if ( YMType == 1 ) then
CNTSTRR0 = Rref
call CNTSTRSetParameterization ( 3 )
end if
if ( STRModel == CNTSTRMODEL_NH0F ) then
call CNTSTRNH0Init ()
else
call CNTSTRNH1Init ()
end if
end if
!CNTSTRAmin = -0.4d+00
!CNTSTRAmax = 0.4d+00
!CNTSTRDA = ( CNTSTRAmax - CNTSTRAmin ) / ( CNTPOTN - 1 )
!A = CNTSTRAmin
!do i = 0, CNTPOTN - 1
! CNTSTRU(i) = 0.5d+00 * A * A
! CNTSTRdUdA(i) = A
! A = A + CNTSTRDA
!end do
end subroutine CNTSTRInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Bending potentials
!---------------------------------------------------------------------------------------------------
subroutine BendingGradients ( K, G0, G1, G2, R0, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This functions calculates degreeiest for bending forces
!-------------------------------------------------------------------------------------------
real(c_double), intent(inout) :: K
real(c_double), dimension(0:2), intent(inout) :: G0, G1, G2
real(c_double), dimension(0:2), intent(in) :: R0, R1, R2
real(c_double), dimension(0:2) :: DR0, DR2
real(c_double) :: L0, L2
!-------------------------------------------------------------------------------------------
DR0 = R0 - R1
DR2 = R2 - R1
L0 = S_V3norm3 ( DR0 )
L2 = S_V3norm3 ( DR2 )
DR0 = DR0 / L0
DR2 = DR2 / L2
K = S_V3xV3 ( DR0, DR2 )
G0 = DR2 - K * DR0
G2 = DR0 - K * DR2
G0 = G0 / L0
G2 = G2 / L2
G1 = - ( G0 + G2 )
end subroutine BendingGradients !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTBNDHCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Bending model of type 0:
! Harmonic bending potential
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: U, dUdC
real(c_double), intent(in) :: C, R0, L0
real(c_double) :: E, K
!-------------------------------------------------------------------------------------------
E = 1.0d+00 - C
K = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0
U = K * ( 1.0d+00 + C ) / E
dUdC = 2.0d+00 * K / ( E * E )
CNTBNDHCalc = CNTPOT_BENDING
end function CNTBNDHCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTBNDHBCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Bending model of type 1:
! Harmonic bending potential with buckling
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: U, dUdC
real(c_double), intent(in) :: C, R0, L0
real(c_double) :: E1, E2, C2, Kbnd, Kbcl, Theta, DUbcl
!-------------------------------------------------------------------------------------------
E1 = 1.0d+00 - C
E2 = 1.0d+00 + C
! Calculate the square of curvature
C2 = 4.0d+00 * E2 / ( L0 * L0 * E1 )
! Check the condition for buckling
if ( C2 .ge. CNTBNDC2 ) then ! Buckling takes place
Theta= M_PI - acos ( C )
Kbnd = 63.8d+00 * R0**2.93d+00
Kbcl = CNTBNDB * Kbnd / CNTBNDR
DUbcl= Kbnd * ( CNTBNDB * ( M_PI - 2.0d+00 * atan ( 2.0 * CNTBNDR / L0 ) ) - 0.5d+00 * L0 / CNTBNDR ) / CNTBNDR
U = Kbcl * abs( Theta )**CNTBNDN - DUbcl
dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C )
CNTBNDHBCalc = CNTPOT_BBUCKLING
else ! Harmonic bending
Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0
U = Kbnd * E2 / E1
dUdC = 2.0d+00 * Kbnd / ( E1 * E1 )
CNTBNDHBCalc = CNTPOT_BENDING
end if
end function CNTBNDHBCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTBNDHBFCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: U, dUdC
real(c_double), intent(in) :: C, R0, L0
real(c_double) :: E1, E2, C2, Kbnd, Kbcl, Theta, DUbcl
!-------------------------------------------------------------------------------------------
E1 = 1.0d+00 - C
E2 = 1.0d+00 + C
! Calculate the square of curvature
C2 = 4.0d+00 * E2 / ( L0 * L0 * E1 )
! Check the condition for buckling
if ( C2 .ge. CNTBNDC2 ) then ! Buckling takes place
Theta= M_PI - acos ( C )
if ( Theta > CNTBNDTF ) then ! Fracture takes place
U = 0.0d+00
dUdC = 0.0d+00
CNTBNDHBFCalc = CNTPOT_BFRACTURE
else
Kbnd = 63.8d+00 * R0**2.93d+00
Kbcl = CNTBNDB * Kbnd / CNTBNDR
DUbcl= Kbnd * ( CNTBNDB * ( M_PI - 2.0d+00 * atan ( 2.0 * CNTBNDR / L0 ) ) - 0.5d+00 * L0 / CNTBNDR ) / CNTBNDR
U = Kbcl * abs ( Theta )**CNTBNDN - DUbcl
dUdC = Kbcl * CNTBNDN * abs ( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C )
CNTBNDHBFCalc = CNTPOT_BBUCKLING
end if
else ! Harmonic bending
Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0
U = Kbnd * E2 / E1
dUdC = 2.0d+00 * Kbnd / ( E1 * E1 )
CNTBNDHBFCalc = CNTPOT_BENDING
end if
end function CNTBNDHBFCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTBNDHBHCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!
! Bending model of type 1:
! Harmonic bending potential with buckling with hysteresis approch.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: U, dUdC, Ebuc
real(c_double), intent(in) :: C , R0, L0
integer(c_int), intent(in) :: BBF
real(c_double) :: E1, E2, C2, Kbnd, Kbcl,Theta,DUbcl, Ubcl, Cmin,Rmax
!-------------------------------------------------------------------------------------------
Rmax = 340.0d+00
Cmin = 1.0/(Rmax*Rmax)
E1 = 1.0d+00 - C
E2 = 1.0d+00 + C
! Calculate the square of curvature
C2 = 4.0d+00 * E2 / ( L0 * L0 * E1 )
Theta = M_PI - acos ( C )
if ( C2 .lt. Cmin ) then ! Harmonic bending
Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0
U = Kbnd * E2 / E1
dUdC = 2.0d+00 * Kbnd / ( E1 * E1 )
CNTBNDHBHCalc = CNTPOT_BENDING
Ebuc = 0.0
else if ( C2 .ge. Cmin .and. C2 .lt. CNTBNDC2 ) then !Potential here depends on buckling flag of node
if ( BBF .eq. 0 ) then ! Not buckled yet. Continue harmonic bending
Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0
U = Kbnd * E2 / E1
dUdC = 2.0d+00 * Kbnd / ( E1 * E1 )
CNTBNDHBHCalc = CNTPOT_BENDING
Ebuc = 0.0d+00
else ! Already has been buckled or is buckled. Use buckling potential until Cmin.
Theta= M_PI - acos ( C )
Kbnd = 63.8d+00 * R0**2.93d+00
Kbcl = CNTBNDB * Kbnd / CNTBNDR
DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN
U = Kbcl * abs( Theta )**CNTBNDN + DUbcl
dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C )
Ebuc = 0.0d+00
CNTBNDHBHCalc = CNTPOT_BBUCKLING
end if
else ! Greater than buckling critical point
if ( BBF .eq. 1 ) then ! Already buckled
Theta= M_PI - acos ( C )
Kbnd = 63.8d+00 * R0**2.93d+00
Kbcl = CNTBNDB * Kbnd / CNTBNDR
DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN
U = Kbcl * abs( Theta )**CNTBNDN + DUbcl
dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C )
Ebuc = 0.0d00
CNTBNDHBHCalc = CNTPOT_BBUCKLING
else ! Newly buckled
Theta= M_PI - acos ( C )
Kbnd = 63.8d+00 * R0**2.93d+00
Kbcl = CNTBNDB * Kbnd / CNTBNDR
DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN
U = Kbcl * abs( Theta )**CNTBNDN + DUbcl
dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C )
Ebuc = 2.0d+00*Kbnd * (1.0d+00+cos(l0/CNTBNDR+M_PI)) / (1.0d+00-cos(l0/CNTBNDR+M_PI))/L0- Kbcl*abs(l0/CNTBNDR)**CNTBNDN-dUbcl
CNTBNDHBHCalc = CNTPOT_BBUCKLING
end if
end if
end function CNTBNDHBHCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! General
!
! integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: U, dUdC, Ebuc
real(c_double), intent(in) :: C, R0, L0
integer(c_int), intent(in) :: BBF
!-------------------------------------------------------------------------------------------
Ebuc = 0.0d+00
select case ( CNTBNDModel )
case ( CNTBNDMODEL_H )
CNTBNDCalc = CNTBNDHCalc ( U, dUdC, C, R0, L0 )
case ( CNTBNDMODEL_HB )
CNTBNDCalc = CNTBNDHBCalc ( U, dUdC, C, R0, L0 )
case ( CNTBNDMODEL_HBF )
CNTBNDCalc = CNTBNDHBFCalc ( U, dUdC, C, R0, L0 )
case ( CNTBNDMODEL_HBH )
CNTBNDCalc = CNTBNDHBHCalc ( U, dUdC, C, R0, L0, BBF, Ebuc )
end select
end function CNTBNDCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CNTBNDInit ( BNDModel ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: BNDModel
real(c_double) :: A, E
integer(c_int) :: i
!-------------------------------------------------------------------------------------------
CNTBNDModel= BNDModel
CNTBNDN1 = CNTBNDN - 1.0d+00
CNTBNDC2 = 1.0d+00 / ( CNTBNDR * CNTBNDR )
!CNTBNDAmin = -1.0d+00
!CNTBNDAmax = 0.99d+00
!CNTBNDDA = ( CNTBNDAmax - CNTBNDAmin ) / ( CNTPOTN - 1 )
!A = CNTBNDAmin
!do i = 0, CNTPOTN - 1
! E = 1.0d+00 - A
! CNTBNDU(i) = 2.0d+00 * ( 1.0d+00 + A ) / E
! CNTBNDdUdA(i) = 4.0d+00 / E / E
! A = A + CNTBNDDA
!end do
end subroutine CNTBNDInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Module initialization
!---------------------------------------------------------------------------------------------------
subroutine InitCNTPotModule ( STRModel, STRParams, YMType, BNDModel, Rref ) !!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: STRModel, STRParams, YMType, BNDModel
real(c_double), intent(in) :: Rref
!-------------------------------------------------------------------------------------------
call CNTSTRInit ( STRModel, STRParams, YMType, Rref )
call CNTBNDInit ( BNDModel )
end subroutine InitCNTPotModule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module CNTPot !*********************************************************************************

125
tools/mesont/ExportCNT.f90
View File

@ -1,125 +0,0 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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: Maxim Shugaev (UVA), mvs9t@virginia.edu
!-------------------------------------------------------------------------
module ExportCNT !*******************************************************************************
use iso_c_binding
use CNTPot
use TPMLib
use TubePotMono
use TPMForceField
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains
subroutine InitCNTPotModule_(STRModel, STRParams, YMType, BNDModel, Rref) &
bind(c, name = "mesont_lib_InitCNTPotModule")
integer(c_int), intent(in) :: STRModel, STRParams, YMType, BNDModel
real(c_double), intent(in) :: Rref
call InitCNTPotModule(STRModel, STRParams, YMType, BNDModel, Rref)
endsubroutine
subroutine TPBInit_() &
bind(c, name = "mesont_lib_TPBInit")
call TPBInit()
endsubroutine
subroutine TPMInit_(M, N) &
bind(c, name = "mesont_lib_TPMInit")
integer(c_int), intent(in) :: M, N
call TPMInit(M, N)
endsubroutine
subroutine SetTablePath_(TPMSSTPFile_, N1, TPMAFile_, N2) &
bind(c, name = "mesont_lib_SetTablePath")
integer(c_int), intent(in) :: N1, N2
character(c_char), intent(in), dimension(N1) :: TPMSSTPFile_
character(c_char), intent(in), dimension(N2) :: TPMAFile_
integer :: i
do i = 1, len(TPMSSTPFile)
if (i <= N1) then
TPMSSTPFile(i:i) = TPMSSTPFile_(i)
else
TPMSSTPFile(i:i) = ' '
endif
enddo
do i = 1, len(TPMAFile)
if (i <= N2) then
TPMAFile(i:i) = TPMAFile_(i)
else
TPMAFile(i:i) = ' '
endif
enddo
endsubroutine
function get_R_ () &
bind(c, name = "mesont_lib_get_R")
real(c_double) :: get_R_
get_R_ = TPMR1
return
endfunction
subroutine TubeStretchingForceField_(U1, U2, F1, F2, S1, S2, X1, X2, R12, L12) &
bind(c, name = "mesont_lib_TubeStretchingForceField")
real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes
real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: L12 ! Equilubrium length of segment (X1,X2)
call TubeStretchingForceField(U1, U2, F1, F2, S1, S2, X1, X2, R12, L12)
endsubroutine
subroutine TubeBendingForceField_(U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2) &
bind(c, name = "mesont_lib_TubeBendingForceField")
real(c_double), intent(inout) :: U1, U2, U3 ! Interaction energies associated with nodes X1, X2, and X3
real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3 ! Forces exerted on nodes X1, X2, and X3
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3 ! Contributions of nodes X1, X2, and X3 to the virial stress tensor
real(c_double), intent(in), dimension(0:2) :: X1, X2, X3 ! Coordinates of nodes
real(c_double), intent(in) :: R123 ! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: L123 ! Equilubrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments)
integer(c_int), intent(inout) :: BBF2
call TubeBendingForceField(U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2 )
endsubroutine
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) &
bind(c, name = "mesont_lib_SegmentTubeForceField")
integer(c_int), intent(in) :: N ! Number of nodes in array X
real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout), dimension(0:N-1) :: U ! Interaction energies associated with nodes X
real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2,0:N-1) :: F ! Forces exerted on nodes X
real(c_double), intent(inout), dimension(0:2) :: Fe ! Force exerted on node Xe (can be updated only if Ee > 0)
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S ! Contributions of nodes X to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: Se ! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0)
real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes
real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in), dimension(0:2,0:N-1) :: X ! Coordinates of the nanotube nodes
real(c_double), intent(in), dimension(0:2) :: Xe ! Additional node of the extended chain if Ee > 0
integer(c_int), intent(in), dimension(0:N-1) :: BBF ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i)
real(c_double), intent(in) :: R ! Radius of nanotube X
integer(c_int), intent(in) :: E1, E2 ! E1 = 1 if the chnane node 0 is a CNT end; E2 = 1 if the chnane node N-1 is a CNT end;
integer(c_int), intent(in) :: Ee ! Parameter defining the type of the extended chain (0,1,2)
integer(c_int), intent(in) :: TPMType ! Type of the tubular potential (0 or 1)
call SegmentTubeForceField(U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType)
endsubroutine
endmodule ExportCNT !**************************************************************************

56
tools/mesont/Makefile.gfortran
View File

@ -1,56 +0,0 @@
SHELL = /bin/sh
# which file will be copied to Makefile.lammps
EXTRAMAKE = Makefile.lammps.gfortran
# ------ FILES ------
SRC = LinFun2.f90 Spline1.f90 Spline2.f90 TPMLib.f90 TPMGeom.f90 TubePotBase.f90 TubePotTrue.f90 \
TubePotMono.f90 TPMM0.f90 TPMM1.f90 CNTPot.f90 TPMForceField.f90 ExportCNT.f90
FILES = $(SRC) Makefile
# ------ DEFINITIONS ------
LIB = libmesont.a
OBJ = $(SRC:.f90=.o)
# ------ SETTINGS ------
F90 = gfortran
CC = gcc
F90FLAGS = -O3 -fPIC -ffast-math -ftree-vectorize -fexpensive-optimizations -fno-second-underscore -g -ffree-line-length-none -cpp
#F90FLAGS = -O
ARCHIVE = ar
ARCHFLAG = -rc
LINK = g++
LINKFLAGS = -O
USRLIB =
SYSLIB =
# ------ MAKE PROCEDURE ------
lib: $(OBJ)
$(ARCHIVE) $(ARFLAGS) $(LIB) $(OBJ)
@cp $(EXTRAMAKE) Makefile.lammps
# ------ COMPILE RULES ------
%.o:%.F
$(F90) $(F90FLAGS) -c $<
%.o:%.f90
$(F90) $(F90FLAGS) -c $<
%.o:%.c
$(CC) $(F90FLAGS) -c $<
#include .depend
# ------ CLEAN ------
clean:
-rm *.o *.mod $(LIB)
tar:
-tar -cvf ../MESONT.tar $(FILES)

52
tools/mesont/Makefile.ifort
View File

@ -1,52 +0,0 @@
SHELL = /bin/sh
# which file will be copied to Makefile.lammps
EXTRAMAKE = Makefile.lammps.ifort
# ------ FILES ------
SRC = LinFun2.f90 Spline1.f90 Spline2.f90 TPMLib.f90 TPMGeom.f90 TubePotBase.f90 TubePotTrue.f90 \
TubePotMono.f90 TPMM0.f90 TPMM1.f90 CNTPot.f90 TPMForceField.f90 ExportCNT.f90
FILES = $(SRC) Makefile
# ------ DEFINITIONS ------
LIB = libmesont.a
OBJ = $(SRC:.f90=.o)
# ------ SETTINGS ------
F90 = ifort
F90FLAGS = -Ofast -fPIC -ipo -fpp
ARCHIVE = ar
ARCHFLAG = -rc
USRLIB =
SYSLIB =
# ------ MAKE PROCEDURE ------
lib: $(OBJ)
$(ARCHIVE) $(ARFLAGS) $(LIB) $(OBJ)
@cp $(EXTRAMAKE) Makefile.lammps
# ------ COMPILE RULES ------
%.o:%.F
$(F90) $(F90FLAGS) -c $<
%.o:%.f90
$(F90) $(F90FLAGS) -c $<
%.o:%.c
$(CC) $(F90FLAGS) -c $<
#include .depend
# ------ CLEAN ------
clean:
-rm *.o *.mod $(LIB)
tar:
-tar -cvf ../MESONT.tar $(FILES)

5
tools/mesont/Makefile.lammps
View File

@ -1,5 +0,0 @@
# Settings that the LAMMPS build will import when this package library is used
mesont_SYSINC =
mesont_SYSLIB = -lgfortran
mesont_SYSPATH =

5
tools/mesont/Makefile.lammps.gfortran
View File

@ -1,5 +0,0 @@
# Settings that the LAMMPS build will import when this package library is used
mesont_SYSINC =
mesont_SYSLIB = -lgfortran
mesont_SYSPATH =

5
tools/mesont/Makefile.lammps.ifort
View File

@ -1,5 +0,0 @@
# Settings that the LAMMPS build will import when this package library is used
mesont_SYSINC =
mesont_SYSLIB = -lifcore -lsvml -limf -ldl -lstdc++ -lgfortran
mesont_SYSPATH = -L/opt/intel/fce/10.0.023/lib

1
tools/mesont/Makefile.serial
View File

@ -1 +0,0 @@
Makefile.gfortran

111
tools/mesont/README
View File

@ -1,67 +1,58 @@
USER-MESONT is a LAMMPS package for simulation of nanomechanics of carbon
nanotubes (CNTs). The model is based on a coarse-grained representation
of CNTs as "flexible cylinders" consisting of a variable number of
segments. Internal interactions within a CNT and the van der Waals
interaction between the tubes are described by a mesoscopic force
field designed and parameterized based on the results of atomic-level
molecular dynamics simulations. The description of the force field
is provided in the papers listed below.
=== USER-MESONT tools ===
===============================
This folder contains a Fortran library implementing basic level functions
describing stretching, bending, and intertube components of the CNT tubular
potential model (TPM) mesoscopic force field.
The programs in this folder can be used to analyze the
output of simulations using the CNT mesoscopic force
field (USER-MESONT).
This library was created by Alexey N. Volkov, University of Alabama,
avolkov1@ua.edu.
dump2vtk.cpp converts output written in *.dump format (the
sequence of columns must be "ATOMS id type x y z Es Eb Et
Ek ix iy iz", the same as in the examples at examples\USER\mesont)
into VTK format that can be visualized as a set of tubes in
Paraview (or other packages). The executable takes 3 parameters:
system.init - an input file with information about connections
between cnt nodes, config.dump - LAMMPS output with snapshots,
out - output folder for writing VTK files (must exist).
--
Code TMDPotGen is designed to generate ASCII text files TPMSSTP.xrs
and TPMA.xrs containing tabulated tubular potentials for
single-walled CNTs with a given chirality (m,n). The input
parameters for the code must be provided in the form of an ASCII
text file TMDPotGen.xdt. The output of the code are files TPMSSTP.xrs
and TPMA.xrs. All parameters in the tables are given in metal units.
The generation of the tables takes approximately 4 hours.
References:
Code TMDGen is designed to generate initial samples composed of
straight and dispersed nanotubes of given chirality and length at
a given material density. In the generated samples, nanotubes are
distributed with random positions and orientations. Both periodic
and free boundary conditions are available along each axis of the
system. The input parameters for the code must be provided in form
of an ASCII text file TMDGen.xdt and include the following:
LS0: sample size along z- and y-directions (A)
HS0: sample size along z-direction (A)
DS0: material density (g/cm^3)
BC_X0: Type of boundary conditions along x-direction (0, Free; 1, Periodic)
BC_Y0: Type of boundary conditions along y-direction (0, Free; 1, Periodic)
BC_Z0: Type of boundary conditions along z-direction (0, Free; 1, Periodic)
ChiIndM: First chirality index of nanotubes
ChiIndN: Second chirality index of nanotubes
LT0: Nanotube length (A)
SegType: Parameter that defines how a nanotubes will be divided into
segments(0, NSeg0 will be used; 1, LSeg0 will be used)
NSeg0: Number of segments in every nanotube. Used if SegType = 0. Then
LSeg0 = LT0 / NSeg0
LSeg0: Length of segments in every nanotube. Used if SegType = 1. Then
NSeg0 = [ LT0 / LSeg0 ]
DeltaT: Minimum gap between nanotube walls in the generated sample (A)
NAmax: Maximum number of attempts to add new nanotube to the sample
GeomPrec: Precision of calculations (dimensionless).
The output of the code is an ASCII text file TMDSample.init written in the
LAMMPS format compatible with cnt atomic style. All parameters in the sample
files generated with TMDGen are given in metal units.
L. V. Zhigilei, C. Wei, and D. Srivastava, Mesoscopic model for dynamic
simulations of carbon nanotubes, Phys. Rev. B 71, 165417, 2005.
A. N. Volkov and L. V. Zhigilei, Structural stability of carbon nanotube
films: The role of bending buckling, ACS Nano 4, 6187-6195, 2010.
A. N. Volkov, K. R. Simov, and L. V. Zhigilei, Mesoscopic model for simulation
of CNT-based materials, Proceedings of the ASME International Mechanical
Engineering Congress and Exposition (IMECE2008), ASME paper IMECE2008-68021,
2008.
A. N. Volkov and L. V. Zhigilei, Mesoscopic interaction potential for carbon
nanotubes of arbitrary length and orientation, J. Phys. Chem. C 114, 5513-5531,
2010.
B. K. Wittmaack, A. H. Banna, A. N. Volkov, L. V. Zhigilei, Mesoscopic
modeling of structural self-organization of carbon nanotubes into vertically
aligned networks of nanotube bundles, Carbon 130, 69-86, 2018.
B. K. Wittmaack, A. N. Volkov, L. V. Zhigilei, Mesoscopic modeling of the
uniaxial compression and recovery of vertically aligned carbon nanotube
forests, Compos. Sci. Technol. 166, 66-85, 2018.
B. K. Wittmaack, A. N. Volkov, L. V. Zhigilei, Phase transformation as the
mechanism of mechanical deformation of vertically aligned carbon nanotube
arrays: Insights from mesoscopic modeling, Carbon 143, 587-597, 2019.
A. N. Volkov and L. V. Zhigilei, Scaling laws and mesoscopic modeling of
thermal conductivity in carbon nanotube materials, Phys. Rev. Lett. 104,
215902, 2010.
A. N. Volkov, T. Shiga, D. Nicholson, J. Shiomi, and L. V. Zhigilei, Effect
of bending buckling of carbon nanotubes on thermal conductivity of carbon
nanotube materials, J. Appl. Phys. 111, 053501, 2012.
A. N. Volkov and L. V. Zhigilei, Heat conduction in carbon nanotube materials:
Strong effect of intrinsic thermal conductivity of carbon nanotubes, Appl.
Phys. Lett. 101, 043113, 2012.
W. M. Jacobs, D. A. Nicholson, H. Zemer, A. N. Volkov, and L. V. Zhigilei,
Acoustic energy dissipation and thermalization in carbon nanotubes: Atomistic
modeling and mesoscopic description, Phys. Rev. B 86, 165414, 2012.
A. N. Volkov and A. H. Banna, Mesoscopic computational model of covalent
cross-links and mechanisms of load transfer in cross-linked carbon nanotube
films with continuous networks of bundles, Comp. Mater. Sci. 176, 109410, 2020.
This packages were created by Maxim Shugaev (mvs9t@virginia.edu)
at the University of Virginia and by Alexey N. Volkov (avolkov1@ua.edu)
at the University of Alabama.

33
tools/mesont/TMDGen/Makefile Normal file
View File

@ -0,0 +1,33 @@
#---------------------------------------------------------------------------------------------------
#
# This is Makefile for builing the executable TMDGen
#
# Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
#
#---------------------------------------------------------------------------------------------------
EXEPATH = .
F90 = ifort
F90FLAGS = -O3 -ipo
LDFLAGS =
OBJS = TPMLib.o TPMGeom.o TMDGenData.o TMDGen3D.o TMDGen.o
EXE = $(EXEPATH)/TMDGen
# compile and load
default:
@echo " "
@echo "Compiling Code of Program TMDGen"
@echo "FORTRAN 90"
$(MAKE) $(EXE)
$(EXE): $(OBJS)
$(F90) $(F90FLAGS) $(LDFLAGS) -o $(EXE) $(OBJS)
.SUFFIXES: .f90 .o
.f90.o:
$(F90) $(F90FLAGS) -c $*.f90
clean:
rm -f *.o

267
tools/mesont/TMDGen/TMDGen.f90 Normal file
View File

@ -0,0 +1,267 @@
program TMDGen !************************************************************************************
!
! Stand-alone generator of 3D CNT samples.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
!
!***************************************************************************************************
use TMDGen3D
implicit none
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
integer*4 :: Nseg, Nnode
real*8 :: DS00
!---------------------------------------------------------------------------------------------------
! Body
!---------------------------------------------------------------------------------------------------
print *, 'TMD generator of 3D CNT samples, v. 13.00'
print '(a34,a,i10)', 'Maximum number of nanotubes', ' : ', MAX_TUBE
call SetRandomSeed ()
! Reading and printing of governing parameters
call LoadGoverningParameters ()
call PrintGoverningParameters ()
! Here we calculate the radius of nanotubes
RT0 = TPBA * sqrt ( 3.0d+00 * ( ChiIndM * ChiIndM + ChiIndN * ChiIndN + ChiIndM * ChiIndN ) ) / M_2PI;
! Here we calculate parameters of the desired sample
call InitSample ()
DS0 = DS0 * ( K_MDDU / 1.0d+03 )
call PrintSampleParameters ( 'Desired' )
DS00 = DS0
DS0 = DS0 / ( K_MDDU / 1.0d+03 )
call Generator3D ()
! Here we write the major output file with the sample
!call WriteOutputFile_old_format ()
!call WriteOutputFile ()
! Here we write an auxiliary Tecplot file to visualize the initial sample
!PrintTecplotFile ()
call WriteLAMMPSFile()
! Here we print parameters of the final sample
call PrintSampleParameters ( 'Final' )
print '(a34,a,f15.4,a)', 'Nanotube radius ', ' : ', RT0, ' a'
print '(a34,a,f15.4,a)', 'Nanotube length ', ' : ', LT0, ' a'
print '(a34,a,f15.4,a)', 'Nanotube mass ', ' : ', M_2PI * RT0 * LT0 * TPBM * TPBD, ' Da'
if ( SegType == 0 ) then
LSeg0 = LT0 / NSeg0
else
NSeg0 = int ( LT0 / LSeg0 ) + 1
LSeg0 = LT0 / NSeg0
end if
print '(a34,a,f15.4,a)', 'Nanotube segment length ', ' : ', LSeg0, ' a'
print '(a34,a,f15.4,a)', 'Nanotube segment mass ', ' : ', M_2PI * RT0 * LSeg0 * TPBM * TPBD, ' Da'
print '(a34,a,f15.4)', 'Desired / Real densities ', ' : ', DS00 / DS0
print '(a34,a,i10)', 'Real number of tubes', ' : ', NT
print '(a34,a,i10)', 'Real number of segments', ' : ', Nseg
print '(a34,a,i10)', 'Real number of nodes', ' : ', Nnode
contains !******************************************************************************************
subroutine DiscretizeTube ( X0, DL, NS, i ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function calculaats geometrical parameters that are necessary to represent straight
! tube i as a sequence of segments.
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2), intent(out) :: X0
real*8, intent(out) :: DL
integer*4, intent(out) :: NS
integer*4, intent(in) :: i
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2) :: X1
!-------------------------------------------------------------------------------------------
call GetTubeEnds ( X0, X1, i )
if ( SegType == 0 ) then
NS = NSeg0
else
NS = int ( LT(i) / LSeg0 ) + 1
end if
DL = LT(i) / NS
end subroutine DiscretizeTube !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine WriteOutputFile_old_format () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function writes a dat file (version 2) with the initial nanotube sample.
! This file is used by TMD/TMDMPI to start a new simulation.
!-------------------------------------------------------------------------------------------
integer*4 :: Fuid, i, j, NTS, Prop
real*8 :: DL, L, L00, M00, I00, J00, C00, LL00, MM00, II00, JJ00, CC00
real*8, dimension(0:2) :: X, X0
logical*4 :: PrintNode
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( 'TMDGen_old.dat', "wt", "" )
write ( unit = Fuid, fmt = '(i12)' ) 3
write ( unit = Fuid, fmt = '(2i4,4e20.12)' ) ChiIndM, ChiIndN, RT0, TPBA, TPBD, TPBM
write ( unit = Fuid, fmt = '(3e20.12)' ) DomXmin, DomYmin, DomZmin
write ( unit = Fuid, fmt = '(3e20.12)' ) DomXmax, DomYmax, DomZmax
write ( unit = Fuid, fmt = '(3i12)' ) BC_X, BC_Y, BC_Z
write ( unit = Fuid, fmt = '(i12)' ) NT
Nseg = 0
Nnode = 0
do i = 0, NT - 1
call DiscretizeTube ( X0, DL, NTS, i )
L00 = LT(i) / NTS
M00 = TubeMass ( i ) / NTS
I00 = 0.0d+00
J00 = M00 * sqr ( RT(i) )
C00 = M00 * TubeSpecificHeat ( i )
Nseg = Nseg + NTS
write ( unit = Fuid, fmt = '(i12)' ) NTS + 1
Nnode = Nnode + NTS + 1
L = 0.0d+00
do j = 0, NTS
X = X0 + L * DT(i,0:2)
MM00 = M00
II00 = I00
JJ00 = J00
CC00 = C00
LL00 = L00
if ( j == 0 .or. j == NTS ) then
MM00 = 0.5d+00 * M00
II00 = 0.5d+00 * I00
JJ00 = 0.5d+00 * J00
CC00 = 0.5d+00 * C00
end if
if ( j == NTS ) LL00 = 0.0d+00
Prop = 0
write ( unit = Fuid, fmt = '(i2,6e20.12)' ) Prop, RT(0), LL00, MM00, II00, JJ00, CC00
write ( unit = Fuid, fmt = '(6e20.12)' ) X, RT(i), 0.0d+00, 300.0d+00
L = L + DL
end do
end do
write ( unit = Fuid, fmt = '(i12)' ) 0
write ( unit = Fuid, fmt = '(i12)' ) 0
call CloseFile ( Fuid )
end subroutine WriteOutputFile_old_format !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine WriteOutputFile () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function writes a dat file (version 2) with the initial nanotube sample.
! This file is used by TMD/TMDMPI to start a new simulation.
!-------------------------------------------------------------------------------------------
integer*4 :: Fuid, i, j, NTS
real*8 :: DL, L, L00, M00, LL00, MM00
real*8, dimension(0:2) :: X, X0
logical*4 :: PrintNode
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( 'TMDGen.dat', "wt", "" )
write ( unit = Fuid, fmt = '(2i4,4e20.12)' ) ChiIndM, ChiIndN, RT0, TPBA, TPBD, TPBM
write ( unit = Fuid, fmt = '(3e20.12)' ) DomXmin, DomYmin, DomZmin
write ( unit = Fuid, fmt = '(3e20.12)' ) DomXmax, DomYmax, DomZmax
write ( unit = Fuid, fmt = '(3i12)' ) BC_X, BC_Y, BC_Z
write ( unit = Fuid, fmt = '(i12)' ) NT
Nseg = 0
Nnode = 0
do i = 0, NT - 1
call DiscretizeTube ( X0, DL, NTS, i )
L00 = LT(i) / NTS
M00 = TubeMass ( i ) / NTS
Nseg = Nseg + NTS
write ( unit = Fuid, fmt = '(i12)' ) NTS + 1
Nnode = Nnode + NTS + 1
L = 0.0d+00
do j = 0, NTS
X = X0 + L * DT(i,0:2)
MM00 = M00
LL00 = L00
if ( j == 0 .or. j == NTS ) MM00 = 0.5d+00 * M00
if ( j == NTS ) LL00 = 0.0d+00
write ( unit = Fuid, fmt = '(5e20.12)' ) X, LL00, MM00
L = L + DL
end do
end do
call CloseFile ( Fuid )
end subroutine WriteOutputFile !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine PrintTecplotFile () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function prints Tecplot file to visualize the generated sample
!-------------------------------------------------------------------------------------------
integer*4 :: Fuid, i
real*8 :: LT2
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( 'TMDGen.plt', "wt", "" )
write ( unit = Fuid, fmt = '(a)' ) 'VARIABLES="X" "Y" "Z"'
do i = 0, NT - 1
write ( unit = Fuid, fmt = '(a,i,a)' ) 'ZONE T="T', i, '"'
LT2 = 0.5d+00 * LT(i)
write ( unit = Fuid, fmt = '(3e20.12)' ) CT(i,0:2) - LT2 * DT(i,0:2)
write ( unit = Fuid, fmt = '(3e20.12)' ) CT(i,0:2) + LT2 * DT(i,0:2)
end do
call CloseFile ( Fuid )
end subroutine PrintTecplotFile !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine WriteLAMMPSFile () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function writes a dat file (version 2) with the initial nanotube sample.
! This file is used by TMD/TMDMPI to start a new simulation.
!-------------------------------------------------------------------------------------------
integer*4 :: file_id, i, j, NTS, node_id, b1, b2
real*8 :: DL, L, L00, M00, LL00, MM00
real*8, dimension(0:2) :: X, X0
logical*4 :: PrintNode
!-------------------------------------------------------------------------------------------
open(newunit = file_id, file = 'TMDSample.init')
write(file_id,*)
write(file_id,*)
!count the number of nodes and segments
Nseg = 0
Nnode = 0
do i = 0, NT - 1
call DiscretizeTube (X0, DL, NTS, i)
Nseg = Nseg + NTS
Nnode = Nnode + NTS + 1
enddo
write(file_id,'(i9,a)') Nnode, " atoms"
write(file_id,*)
write(file_id,*) "1 atom types"
write(file_id,*)
write(file_id,'(2e20.12,2a)') DomXmin, DomXmax, " xlo xhi"
write(file_id,'(2e20.12,2a)') DomYmin, DomYmax, " ylo yhi"
write(file_id,'(2e20.12,2a)') DomZmin, DomZmax, " zlo zhi"
write(file_id,*)
write(file_id,*) "Masses"
write(file_id,*)
write(file_id,*) "1 1.0"
write(file_id,*)
write(file_id,*) "Atoms"
write(file_id,*)
node_id = 1
do i = 0, NT - 1
call DiscretizeTube(X0, DL, NTS, i)
L00 = LT(i) / NTS
M00 = TubeMass (i) / NTS
b1 = -1
L = 0.0d+00
do j = 0, NTS
b2 = node_id + 1
if (j == NTS) b2 = -1
MM00 = M00
LL00 = L00
if (j == 0 .or. j == NTS) MM00 = 0.5d+00 * M00
if (j == NTS) LL00 = 0.0d+00
X = X0 + L * DT(i,0:2)
write(file_id,'(2i9,a,2i9,3e14.7,a,3e20.12,a)') node_id, i, " 1 ", b1, b2, MM00, RT(i), LL00, " 0 ", X, " 0 0 0"
b1 = node_id
node_id = node_id + 1
L = L + DL
enddo
enddo
close(file_id)
end subroutine !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end program TMDGen !********************************************************************************

15
tools/mesont/TMDGen/TMDGen.xdt Normal file
View File

@ -0,0 +1,15 @@
0.400000000000E+04 : LS0, A
0.400000000000E+04 : HS0, A
0.010000000000E+00 : DS0, Density g/cm^3
1 : BC_X0, periodic along X
1 : BC_Y0, periodic along Y
0 : BC_Z0, periodic along Z
10 : ChiIndM, tube chirality M
10 : ChiIndN, tube chirality N
0.200000000000E+04 : LT0, A
0 : SegType
100 : NSeg0
0.200000000000E+02 : LSeg0
0.500000000000E+01 : DeltaT, A
1000000 : NAmax
0.100000000000E-06 : GeomPrec

231
tools/mesont/TMDGen/TMDGen3D.f90 Normal file
View File

@ -0,0 +1,231 @@
module TMDGen3D !***********************************************************************************
!
! Generator of 3D CNT samples for TPM force field
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!---------------------------------------------------------------------------------------------------
use TMDGenData
implicit none
contains !******************************************************************************************
real*8 function MinimalDistance3D ( S1, S2, H, cosA, P, Q ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the minimum distance between two line segments in 3D
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: S1, S2
real*8, intent(in) :: H, cosA
real*8, dimension(0:1), intent(in) :: P, Q
!-------------------------------------------------------------------------------------------
real*8 :: H2, cosA2, D
real*8, dimension(0:1) :: P1, Q1
integer*4, dimension(0:1,0:1) :: KA
integer*4 :: i, j, K
!-------------------------------------------------------------------------------------------
if ( ( P(0) * P(1) .le. 0.0d+00 ) .and. ( Q(0) * Q(1) .le. 0.0d+00 ) ) then
MinimalDistance3D = H
S1 = 0.5d+00 * ( P(0) + P(1) )
S2 = 0.5d+00 * ( Q(0) + Q(1) )
return
end if
do i = 0, 1
P1(i) = P(i) * cosA
Q1(i) = Q(i) * cosA
end do
KA = 1
K = 0
do i = 0, 1
if ( ( Q1(i) .ge. P(0) ) .and. ( Q1(i) .le. P(1) ) ) then
D = sqr ( Q(i) )
if ( K == 0 ) then
MinimalDistance3D = D
S1 = Q1(i)
S2 = Q(i)
K = 1
else if ( D < MinimalDistance3D ) then
MinimalDistance3D = D
S1 = Q1(i)
S2 = Q(i)
end if
KA(0,i) = 0
KA(1,i) = 0
end if
if ( ( P1(i) .ge. Q(0) ) .and. ( P1(i) .le. Q(1) ) ) then
D = sqr ( P(i) )
if ( K == 0 ) then
MinimalDistance3D = D
S1 = P(i)
S2 = P1(i)
K = 1
else if ( D < MinimalDistance3D ) then
MinimalDistance3D = D
S1 = P(i)
S2 = P1(i)
end if
KA(i,0) = 0
KA(i,1) = 0
end if
end do
H2 = sqr ( H )
cosA2 = 2.0d+00 * cosA
if ( K == 1 ) MinimalDistance3D = H2 + MinimalDistance3D * ( 1.0d+00 - sqr ( cosA ) )
do i = 0, 1
do j = 0, 1
if ( KA(i,j) == 1 ) then
D = H2 + sqr ( P(i) ) + sqr ( Q(j) ) - P(i) * Q(j) * cosA2
if ( K == 0 ) then
MinimalDistance3D = D
S1 = P(i)
S2 = Q(j)
K = 1
else if ( D < MinimalDistance3D ) then
MinimalDistance3D = D
S1 = P(i)
S2 = Q(j)
end if
end if
end do
end do
MinimalDistance3D = dsqrt ( MinimalDistance3D )
end function MinimalDistance3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine RandTube3D ( X, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This subroutine generates a random tube in an isotropic 3D sample
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2), intent(out) :: X, L
!-------------------------------------------------------------------------------------------
real*8 :: CT, ST, E
!-------------------------------------------------------------------------------------------
if ( BC_X0 == 0 ) then
X(0)= LS0 * randnumber ()
else
X(0)= LS0 * ( 0.5d+00 - 1.0d+00 * randnumber () )
end if
if ( BC_Y0 == 0 ) then
X(1)= LS0 * randnumber ()
else
X(1)= LS0 * ( 0.5d+00 - 1.0d+00 * randnumber () )
end if
if ( BC_Z0 == 0 ) then
X(2)= HS0 *randnumber ()
else
X(2)= HS0 * ( 0.5d+00 - 1.0d+00 * randnumber () )
end if
CT = 1.0d+00 - 2.0d+00 * randnumber ()
ST = sqrt ( 1.0d+00 - sqr ( CT ) )
E = M_2PI * randnumber ()
L(0)= CT
L(1)= ST * cos ( E )
L(2)= ST * sin ( E )
end subroutine RandTube3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
logical function AddTubeToSample3D ( MS ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function adds the last generated tube to the existing sample, if possible.
! In a case of periodic boundaries, this version is valid only f the tube length is smaller
! than the half of the sample.
!-------------------------------------------------------------------------------------------
real*8, intent(inout) :: MS
!-------------------------------------------------------------------------------------------
integer*4 :: i, m
real*8 :: Dmin, LT2, H, cosA, D1, D2, S1, S2
real*8, dimension(0:2) :: X, L12
real*8, dimension(0:1) :: P, Q
!-------------------------------------------------------------------------------------------
AddTubeToSample3D = .false.
if ( .not. IsTubeInside ( NT ) ) return
LT2 = 0.5d+00 * LT(NT)
do m = 0, NT - 1
X = CT(NT,0:2)
if ( LineLine ( H, cosA, D1, D2, L12, X, DT(NT,0:2), CT(m,0:2), DT(m,0:2), GeomPrec ) == MD_LINES_NONPAR ) then
P(0) = D1 - LT2
P(1) = D1 + LT2
Q(0) = D2 - 0.5d+00 * LT(m)
Q(1) = D2 + 0.5d+00 * LT(m)
Dmin = MinimalDistance3D ( S1, S2, H, cosA, P, Q )
else
call LinePoint ( H, L12, CT(m,0:2), DT(m,0:2), X )
L12 = L12 - X
call ApplyPeriodicBC ( L12 )
Dmin = S_V3norm3 ( L12 )
end if
if ( Dmin < RT(NT) + RT(m) + DeltaT ) return
end do
MS = MS + TubeMass ( NT )
NT = NT + 1
AddTubeToSample3D = .true.
end function AddTubeToSample3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine Generator3D () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This subroutine implements the whole fgenerator of 3D samples
!-------------------------------------------------------------------------------------------
integer*4 :: NA, NT0
real*8 :: MS
real*8 :: X1, X2, Y1, Y2, Z1, Z2
!-------------------------------------------------------------------------------------------
NT = 0
MS = 0.0d+00
NT0 = int ( MS0 / ( M_2PI * RT0 * LT0 * TPBM * TPBD ) )
do
if ( NT == MAX_TUBE ) then
print *, 'Error in [Generator3D]: MAX_TUBE is too small'
stop
end if
if ( MS .ge. MS0 ) exit
NA = 0
! Trying to add the tube to the sample
! The maximal number of attempts is equal to NAmax
RT(NT) = RT0
LT(NT) = LT0
do
if ( NA == NAmax ) exit
call RandTube3D ( CT(NT,0:2), DT(NT,0:2) )
if ( AddTubeToSample3D ( MS ) ) then
print '(a,i10,a,i10,a,i10)', 'Tube ', NT, '(Appr.', NT0, ' total): Attempt ', NA
if ( BC_X0 == 0 ) then
X1 = CT(NT,0) - 0.5d+00 * LT(NT) * DT(NT,0)
X2 = CT(NT,0) + 0.5d+00 * LT(NT) * DT(NT,0)
if ( DomXmin > X1 ) DomXmin = X1
if ( DomXmin > X2 ) DomXmin = X2
if ( DomXmax < X1 ) DomXmax = X1
if ( DomXmax < X2 ) DomXmax = X2
end if
if ( BC_Y0 == 0 ) then
Y1 = CT(NT,1) - 0.5d+00 * LT(NT) * DT(NT,1)
Y2 = CT(NT,1) + 0.5d+00 * LT(NT) * DT(NT,1)
if ( DomYmin > Y1 ) DomYmin = Y1
if ( DomYmin > Y2 ) DomYmin = Y2
if ( DomYmax < Y1 ) DomYmax = Y1
if ( DomYmax < Y2 ) DomYmax = Y2
end if
if ( BC_Z0 == 0 ) then
Z1 = CT(NT,2) - 0.5d+00 * LT(NT) * DT(NT,2)
Z2 = CT(NT,2) + 0.5d+00 * LT(NT) * DT(NT,2)
if ( DomZmin > Z1 ) DomZmin = Z1
if ( DomZmin > Z2 ) DomZmin = Z2
if ( DomZmax < Z1 ) DomZmax = Z1
if ( DomZmax < Z2 ) DomZmax = Z2
end if
exit
end if
NA = NA + 1
end do
end do
MS0 = MS
if ( BC_X0 == 0 ) DomLX = DomXmax - DomXmin
if ( BC_Y0 == 0 ) DomLY = DomYmax - DomYmin
if ( BC_Z0 == 0 ) DomLZ = DomZmax - DomZmin
VS0 = ( DomXmax - DomXmin ) * ( DomYmax - DomYmin ) * ( DomZmax - DomZmin )
DS0 = MS0 / VS0 * ( K_MDDU / 1.0d+03 )
end subroutine Generator3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TMDGen3D !*******************************************************************************

289
tools/mesont/TMDGen/TMDGenData.f90 Normal file
View File

@ -0,0 +1,289 @@
module TMDGenData !*********************************************************************************
!
! Common data for TMDGen
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!---------------------------------------------------------------------------------------------------
use TPMGeom
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
integer*4, parameter :: MAX_TUBE = 1000000 ! Maximum number of tubes in 3D
real*8, parameter :: K_MDDU = K_MDMU / K_MDLU / K_MDLU / K_MDLU ! MD density unit (kg/m**3)
!
! These parameters are specific for carbon nanotubes and taken from module TubePotBase
!
real*8, parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5
! Mass of C atom
real*8, parameter :: TPBM = 12.0107d+00 ! (a.m.u.)
! Lattice parameter and numerical density of atoms for a graphene sheet, see Dresselhaus et al, Carbon 33(7), 1995
real*8, parameter :: TPBA = 1.421d+00 ! (Angstrom)
real*8, parameter :: TPBD = 4.0d+00 / ( TPBConstD * TPBA * TPBA ) ! (1/Angstrom^2)
! Specific heat of carbon nanotubes
real*8, parameter :: TPBSH = 600.0d+00 / K_MDCU ! (eV/(Da*K))
!---------------------------------------------------------------------------------------------------
! Governing parameters
!---------------------------------------------------------------------------------------------------
! Parameters of the sample
real*8 :: LS0 = 4000.0 ! Sample size in x, y-directions (Angstrom)
real*8 :: HS0 = 4000.0 ! Sample size in z-direction (Angstrom)
real*8 :: DS0 = 0.01 ! Density (g/cm**3)
integer*4 :: BC_X0 = 1 ! Boundary conditions in x-direction: 0, free; 1, periodic
integer*4 :: BC_Y0 = 1 ! Boundary conditions in y-direction: 0, free; 1, periodic
integer*4 :: BC_Z0 = 1 ! Boundary conditions in z-direction: 0, free; 1, periodic
! Parameters of tubes
integer*4 :: ChiIndM = 10 ! Chirality index m of nanotubes
integer*4 :: ChiIndN = 10 ! Chirality index n of nanotubes
real*8 :: LT0 = 2000.0 ! Characterstic length of tubes (Angstrom)
integer*4 :: SegType = 0 ! 0, number of segments per tube is fixed
! 1, rounded length of segments is fixed
integer*4 :: NSeg0 = 100 ! Number of segments per tube
real*8 :: LSeg0 = 20.0d+00 ! Length of the segment (Angstrom)
! Parameters controlling the sample structure
real*8 :: DeltaT = 3.0 ! Minimal distance between tubes (Angstrom)
integer*4 :: NAmax = 50000 ! Maximal number of attempts (for SampleType = 4 it is used as an input paramtere for number of tubes)
real*8 :: GeomPrec = 1.0d-06 ! Geometrical precision
!---------------------------------------------------------------------------------------------------
! Computed data
!---------------------------------------------------------------------------------------------------
real*8 :: RT0 = 6.785 ! Radius of tubes (Angstrom)
real*8 :: VS0 ! Desired volume of the sample, Angstrom**3
real*8 :: MS0 ! Desired mass of the sample, Da (For SampleType = 4 it is the defined fixed mass- definition is given in TMDGen7T)
real*8 :: CTCD ! Center to center distance between any surrounding tube and center tube (used for SampleType == 4 only)
integer*4 :: NT ! Real number of tubes
real*8, dimension(0:MAX_TUBE-1) :: RT ! Radii of tubes, Angstrom
real*8, dimension(0:MAX_TUBE-1) :: LT ! Lengths of tubes, Angstrom
real*8, dimension(0:MAX_TUBE-1,0:2) :: CT ! Coordinates of tubes' centers, Angstrom
real*8, dimension(0:MAX_TUBE-1,0:2) :: DT ! Directions of tubes
integer*4, dimension(0:MAX_TUBE-1) :: AT ! Parent axes of tubes. It is used only in GeneratorBundle ()
contains !******************************************************************************************
!---------------------------------------------------------------------------------------------------
! Pseudo-random number generator
!---------------------------------------------------------------------------------------------------
real*8 function randnumber () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns a pseudo-random number with uniform distribution in [0,1]
!-------------------------------------------------------------------------------------------
call random_number ( randnumber )
end function randnumber !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine SetRandomSeed () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This subroutine sets random seed for the pseudo-random number generator
!-------------------------------------------------------------------------------------------
integer :: i, n, clock
integer, dimension(:), allocatable :: seed
!-------------------------------------------------------------------------------------------
call RANDOM_SEED ( size = n )
allocate ( seed(n) )
call SYSTEM_CLOCK ( COUNT = clock )
seed = clock + 37 * (/ (i - 1, i = 1, n) /)
call RANDOM_SEED ( PUT = seed )
deallocate ( seed )
end subroutine SetRandomSeed !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Generators for (random) properties of nanotubes
!---------------------------------------------------------------------------------------------------
real*8 function TubeMass ( i ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the mass of the tube in Da
!-------------------------------------------------------------------------------------------
integer*4, intent(in) :: i
!-------------------------------------------------------------------------------------------
TubeMass = M_2PI * RT(i) * LT(i) * TPBM * TPBD
end function TubeMass !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8 function TubeSpecificHeat ( i ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the specific heat of the tube
!-------------------------------------------------------------------------------------------
integer*4, intent(in) :: i
!-------------------------------------------------------------------------------------------
TubeSpecificHeat = TPBSH
end function TubeSpecificHeat !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Reading and printing of input parameters
!---------------------------------------------------------------------------------------------------
subroutine LoadGoverningParameters () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function reads governing parameters from xdt file
!-------------------------------------------------------------------------------------------
integer*4 :: Fuid, i
character*512 :: Msg
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( 'TMDGen.xdt', 'rt', '' )
read ( unit = Fuid, fmt = '(e22.12)' ) LS0
read ( unit = Fuid, fmt = '(e22.12)' ) HS0
read ( unit = Fuid, fmt = '(e22.12)' ) DS0
read ( unit = Fuid, fmt = '(i22)' ) BC_X0
read ( unit = Fuid, fmt = '(i22)' ) BC_Y0
read ( unit = Fuid, fmt = '(i22)' ) BC_Z0
read ( unit = Fuid, fmt = '(i22)' ) ChiIndM
read ( unit = Fuid, fmt = '(i22)' ) ChiIndN
read ( unit = Fuid, fmt = '(e22.12)' ) LT0
read ( unit = Fuid, fmt = '(i22)' ) SegType
read ( unit = Fuid, fmt = '(i22)' ) NSeg0
read ( unit = Fuid, fmt = '(e22.12)' ) LSeg0
read ( unit = Fuid, fmt = '(e22.12)' ) DeltaT
read ( unit = Fuid, fmt = '(i22)' ) NAmax
read ( unit = Fuid, fmt = '(e22.12)' ) GeomPrec
call CloseFile ( Fuid )
end subroutine LoadGoverningParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine PrintGoverningParameters () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function prints governing parameters to xlg file
!-------------------------------------------------------------------------------------------
integer*4 :: Fuid, i
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( 'TMDGen.xlg', 'wt', '' )
write ( unit = Fuid, fmt = '(e22.12,a)' ) LS0, ' : LS0, Angstrom'
write ( unit = Fuid, fmt = '(e22.12,a)' ) HS0, ' : HS0, Angstrom'
write ( unit = Fuid, fmt = '(e22.12,a)' ) DS0, ' : DS0, g/cm**3'
write ( unit = Fuid, fmt = '(e22.12,a)' ) DS0, ' : SC0, 1/A**2'
write ( unit = Fuid, fmt = '(i22,a)' ) BC_X0, ' : BC_X0'
write ( unit = Fuid, fmt = '(i22,a)' ) BC_Y0, ' : BC_Y0'
write ( unit = Fuid, fmt = '(i22,a)' ) BC_Z0, ' : BC_Z0'
write ( unit = Fuid, fmt = '(i22,a)' ) ChiIndM, ' : ChiIndM'
write ( unit = Fuid, fmt = '(i22,a)' ) ChiIndN, ' : ChiIndN'
write ( unit = Fuid, fmt = '(e22.12,a)' ) LT0, ' : LT0, Angstrom'
write ( unit = Fuid, fmt = '(i22,a)' ) SegType, ' : SegType'
write ( unit = Fuid, fmt = '(i22,a)' ) NSeg0, ' : NSeg0'
write ( unit = Fuid, fmt = '(e22.12,a)' ) LSeg0, ' : LSeg0, Angstrom'
write ( unit = Fuid, fmt = '(e22.12,a)' ) DeltaT, ' : DeltaT'
write ( unit = Fuid, fmt = '(i22,a)' ) NAmax, ' : NAmax'
write ( unit = Fuid, fmt = '(e22.12,a)' ) GeomPrec, ' : GeomPrec'
call CloseFile ( Fuid )
end subroutine PrintGoverningParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Printing of sample parameters
!---------------------------------------------------------------------------------------------------
subroutine PrintSampleParameters ( ParType ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function prints the most imprtant parameters of the sample.
! In the code, it used twice to print parameters of the desired and really generated samples.
!-------------------------------------------------------------------------------------------
character*(*), intent(in) :: ParType
real*8 :: MP, M, V
!-------------------------------------------------------------------------------------------
print '(a,a,a)', '*** ', trim(ParType), ' properties of the sample'
print '(a34,a,f15.4,a)', 'L', ' : ', LS0, ' A'
print '(a34,a,f15.4,a)', 'H', ' : ', HS0, ' A'
print '(a34,a,f15.4,a)', 'Density', ' : ', DS0, ' g/cm**3'
print '(a34,a,e15.8,a)', 'Volume', ' : ', VS0, ' A*3'
print '(a34,a,e15.8,a)', 'Mass', ' : ', MS0, ' Da'
print '(a34,a,i10)', 'BC_X', ' : ', BC_X0
print '(a34,a,i10)', 'BC_Y', ' : ', BC_Y0
print '(a34,a,i10)', 'BC_Z', ' : ', BC_Z0
end subroutine PrintSampleParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Initializing of basic geometrical parameters of the generated sample
!---------------------------------------------------------------------------------------------------
subroutine InitSample () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function initializes the geometrical parameters of the sample (sizes, etc.)
!-------------------------------------------------------------------------------------------
BC_X = BC_X0
BC_Y = BC_Y0
BC_Z = BC_Z0
DomXmin = - LS0 / 2.0d+00
DomXmax = LS0 / 2.0d+00
DomYmin = - LS0 / 2.0d+00
DomYmax = LS0 / 2.0d+00
DomZmin = - HS0 / 2.0d+00
DomZmax = HS0 / 2.0d+00
if ( BC_X0 == 0 ) then
DomXmin = 0.0d+00
DomXmax = LS0
end if
if ( BC_Y0 == 0 ) then
DomYmin = 0.0d+00
DomYmax = LS0
end if
if ( BC_Z0 == 0 ) then
DomZmin = 0.0d+00
DomZmax = HS0
end if
DomLX = DomXmax - DomXmin
DomLY = DomYmax - DomYmin
DomLZ = DomZmax - DomZmin
DomLXHalf = 0.5d+00 * DomLX
DomLYHalf = 0.5d+00 * DomLY
DomLZHalf = 0.5d+00 * DomLZ
DS0 = DS0 / ( K_MDDU / 1.0d+03 )
VS0 = LS0 * LS0 * HS0
MS0 = DS0 * VS0
end subroutine InitSample !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! A few auxiliary functions
!---------------------------------------------------------------------------------------------------
subroutine GetTubeEnds ( X0, X1, i ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function calculates coordinates of two ends of nanotube i
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2), intent(out) :: X0, X1
integer*4, intent(in) :: i
!-------------------------------------------------------------------------------------------
real*8 :: LT2
!-------------------------------------------------------------------------------------------
LT2 = 0.5d+00 * LT(i)
X0 = CT(i,0:2) - LT2 * DT(i,0:2)
X1 = CT(i,0:2) + LT2 * DT(i,0:2)
end subroutine GetTubeEnds !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
logical function IsTubeInside ( i ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns true if nanotube i lies inside the sample. Otherwise it returns false.
!-------------------------------------------------------------------------------------------
integer*4, intent(in) :: i
!-------------------------------------------------------------------------------------------
integer*4 :: n
real*8, dimension(0:2) :: X0, X1, Xmin, Xmax
!-------------------------------------------------------------------------------------------
IsTubeInside = .true.
if ( BC_X == 1 .and. BC_Y == 1 .and. BC_Z == 1 ) return
call GetTubeEnds ( X0, X1, i )
do n = 0, 2
Xmin(n) = min ( X0(n), X1(n) )
Xmax(n) = max ( X0(n), X1(n) )
end do
IsTubeInside = .false.
if ( BC_X == 0 .and. ( Xmin(0) < DomXmin .or. Xmax(0) > DomXmax ) ) return
if ( BC_Y == 0 .and. ( Xmin(1) < DomYmin .or. Xmax(1) > DomYmax ) ) return
if ( BC_Z == 0 .and. ( Xmin(2) < DomZmin .or. Xmax(2) > DomZmax ) ) return
IsTubeInside = .true.
end function IsTubeInside !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TMDGenData !*****************************************************************************

45
tools/mesont/TMDGen/TMDSample.in Normal file
View File

@ -0,0 +1,45 @@
newton on
log cnt.log
echo both
units metal
lattice sc 1.0
boundary p p fs
neighbor 1.0 bin
neigh_modify every 5 delay 0 check yes
atom_style cnt
#cut, RT, STRMode, BendingMode, STRParams, YMType, TPMType, TPMSSTP.xrs, TPMA.xrs
pair_style cnt/cnt 45.0 6.785 1 0 3 0 0 ../../../potentials/TPMSSTP.xrs ../../../potentials/TPMA.xrs
read_data TMDSample.init
pair_coeff * *
velocity all create 600.0 2019
timestep 0.010
fix 1 all nve
#fix 1 all nvt temp 300.0 300.0 1.0
thermo_modify flush yes
thermo 1
reset_timestep 0
compute Es all cnt/Es
compute Eb all cnt/Eb
compute Et all cnt/Et
compute Ek all ke/atom
compute Es_tot all cnt/Es_tot
compute Eb_tot all cnt/Eb_tot
compute Et_tot all cnt/Et_tot
compute Ep_tot all pe
compute Ek_tot all ke
variable time_ equal time
variable Ep_ equal c_Ep_tot
variable Ek_ equal c_Ek_tot
variable Etot_ equal v_Ek_+v_Ep_
variable Es_ equal c_Es_tot
variable Eb_ equal c_Eb_tot
variable Et_ equal c_Et_tot
dump out_dump all custom 50 config_E.dump id type x y z c_Es c_Eb c_Et c_Ek ix iy iz
fix out_info all print 10 "${time_} ${Etot_} ${Ek_} ${Ep_} ${Es_} ${Eb_} ${Et_}" file "E.txt" screen no
run 50
write_data system_E.data

61
tools/mesont/TPMGeom.f90 → tools/mesont/TMDGen/TPMGeom.f90
View File

@ -1,57 +1,42 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 TPMGeom !************************************************************************************
!
! TMD Library: Geometry functions
! Geometry functions for TPM force field
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
!
!***************************************************************************************************
use TPMLib
use iso_c_binding, only : c_int, c_double, c_char
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
integer(c_int), parameter :: MD_LINES_NONPAR = 0
integer(c_int), parameter :: MD_LINES_PAR = 1
integer*4, parameter :: MD_LINES_NONPAR = 0
integer*4, parameter :: MD_LINES_PAR = 1
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
! Coordinates of the whole domain
real(c_double) :: DomXmin, DomXmax, DomYmin, DomYmax, DomZmin, DomZmax
real(c_double) :: DomLX, DomLY, DomLZ
real(c_double) :: DomLXhalf, DomLYhalf, DomLZhalf
real*8 :: DomXmin, DomXmax, DomYmin, DomYmax, DomZmin, DomZmax
real*8 :: DomLX, DomLY, DomLZ
real*8 :: DomLXhalf, DomLYhalf, DomLZhalf
! Boundary conditions
integer(c_int) :: BC_X = 0
integer(c_int) :: BC_Y = 0
integer(c_int) :: BC_Z = 0
integer*4 :: BC_X = 0
integer*4 :: BC_Y = 0
integer*4 :: BC_Z = 0
! Skin parameter in NBL and related algorithms
real(c_double) :: Rskin = 1.0d+00
real*8 :: Rskin = 1.0d+00
contains !******************************************************************************************
@ -59,7 +44,7 @@ contains !**********************************************************************
! This subroutine changes coortinates of the point accorning to periodic boundary conditions
! it order to makesure that the point is inside the computational cell
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2), intent(inout) :: R
real*8, dimension(0:2), intent(inout) :: R
!-------------------------------------------------------------------------------------------
! These commented lines implemment the more general, but less efficient algorithm
!if ( BC_X == 1 ) R(0) = R(0) - DomLX * roundint ( R(0) / DomLX )
@ -92,9 +77,9 @@ contains !**********************************************************************
! This function calculates the point Q of projection of point R0 on line (R1,L1)
! Q = R1 + Disaplacement * L1
!-------------------------------------------------------------------------------------------
real(c_double), intent(inout) :: Displacement
real(c_double), dimension(0:2), intent(inout) :: Q
real(c_double), dimension(0:2), intent(in) :: R1, L1, R0
real*8, intent(inout) :: Displacement
real*8, dimension(0:2), intent(inout) :: Q
real*8, dimension(0:2), intent(in) :: R1, L1, R0
!--------------------------------------------------------------------------------------------
Q = R0 - R1
! Here we take into account periodic boundaries
@ -103,7 +88,7 @@ contains !**********************************************************************
Q = R1 + Displacement * L1
end subroutine LinePoint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!!!!!!!
integer*4 function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!!!!!!!
! This function determines the neares distance H between two lines (R1,L1) and (R2,L2)
!-------------------------------------------------------------------------------------------
! Input values:
@ -116,13 +101,13 @@ contains !**********************************************************************
! D1, D2, displacemets
! L12, unit vector directed along the closes distance
!-------------------------------------------------------------------------------------------
real(c_double), intent(inout) :: H, cosA, D1, D2
real(c_double), dimension(0:2), intent(out) :: L12
real(c_double), dimension(0:2), intent(in) :: R1, L1, R2, L2
real*8, intent(inout) :: H, cosA, D1, D2
real*8, dimension(0:2), intent(out) :: L12
real*8, dimension(0:2), intent(in) :: R1, L1, R2, L2
!-------------------------------------------------------------------------------------------
real(c_double), intent(in) :: Prec
real(c_double), dimension(0:2) :: Q1, Q2, R
real(c_double) :: C, DD1, DD2, C1, C2
real*8, intent(in) :: Prec
real*8, dimension(0:2) :: Q1, Q2, R
real*8 :: C, DD1, DD2, C1, C2
!-------------------------------------------------------------------------------------------
cosA = S_V3xV3 ( L1, L2 )
C = 1.0 - sqr ( cosA )

205
tools/mesont/TMDGen/TPMLib.f90 Normal file
View File

@ -0,0 +1,205 @@
module TPMLib !*************************************************************************************
!
! Common constants, types, and functions for TPM force field
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
!
!***************************************************************************************************
implicit none
!---------------------------------------------------------------------------------------------------
! Mathematical constants
!---------------------------------------------------------------------------------------------------
real*8, parameter :: M_PI_2 = 1.57079632679489661923
real*8, parameter :: M_PI = 3.14159265358979323846
real*8, parameter :: M_3PI_2 = 4.71238898038468985769
real*8, parameter :: M_2PI = 6.28318530717958647692
real*8, parameter :: M_PI_180 = 0.017453292519943295769
!---------------------------------------------------------------------------------------------------
! Physical unit constants
!---------------------------------------------------------------------------------------------------
real*8, parameter :: K_AMU = 1.66056E-27 ! a.m.u. (atomic mass unit, Dalton)
real*8, parameter :: K_EV = 1.60217646e-19 ! eV (electron-volt)
real*8, parameter :: K_MDLU = 1.0E-10 ! MD length unit (m)
real*8, parameter :: K_MDEU = K_EV ! MD energy unit (J)
real*8, parameter :: K_MDMU = K_AMU ! MD mass unit (kg)
real*8, parameter :: K_MDFU = K_MDEU / K_MDLU ! MD force unit (N)
real*8, parameter :: K_MDCU = K_MDEU / K_MDMU ! MD specific heat unit (J/(kg*K))
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
integer*4 :: StdUID = 31
contains !******************************************************************************************
!---------------------------------------------------------------------------------------------------
! Simple mathematical functions
!---------------------------------------------------------------------------------------------------
real*8 function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: X
!-------------------------------------------------------------------------------------------
rad = X * M_PI_180
end function rad !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8 function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: X
!-------------------------------------------------------------------------------------------
sqr = X * X
end function sqr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: X
!-------------------------------------------------------------------------------------------
if ( X > 0 ) then
signum = 1
else if ( X < 0 ) then
signum = -1
else
signum = 0
end if
end function signum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Vector & matrix functions
!---------------------------------------------------------------------------------------------------
real*8 function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, dimension(0:2), intent(in) :: V
!-------------------------------------------------------------------------------------------
S_V3xx = V(0) * V(0) + V(1) * V(1) + V(2) * V(2)
end function S_V3xx !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8 function S_V3xV3 ( V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, dimension(0:2), intent(in) :: V1, V2
!-------------------------------------------------------------------------------------------
S_V3xV3 = V1(0) * V2(0) + V1(1) * V2(1) + V1(2) * V2(2)
end function S_V3xV3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8 function S_V3norm3 ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, dimension(0:2), intent(in) :: V
!-------------------------------------------------------------------------------------------
S_V3norm3 = dsqrt ( V(0) * V(0) + V(1) * V(1) + V(2) * V(2) )
end function S_V3norm3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine V3_ort ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Vector production
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2), intent(inout) :: V
!-------------------------------------------------------------------------------------------
real*8 :: Vabs
!-------------------------------------------------------------------------------------------
Vabs = S_V3norm3 ( V )
V(0) = V(0) / Vabs
V(1) = V(1) / Vabs
V(2) = V(2) / Vabs
end subroutine V3_ort !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine V3_V3xxV3 ( V, V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Vector production
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2), intent(out) :: V
real*8, dimension(0:2), intent(in) :: V1, V2
!-------------------------------------------------------------------------------------------
V(0) = V1(1) * V2(2) - V1(2) * V2(1)
V(1) = V1(2) * V2(0) - V1(0) * V2(2)
V(2) = V1(0) * V2(1) - V1(1) * V2(0)
end subroutine V3_V3xxV3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Handling of spherical and Euler angles
!---------------------------------------------------------------------------------------------------
subroutine RotationMatrix3 ( M, Psi, Tet, Phi ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Ksi, Tet and Phi are Euler angles
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2,0:2), intent(out) :: M
real*8, intent(in) :: Psi, Tet, Phi
!-------------------------------------------------------------------------------------------
real*8 :: cK, sK, cT, sT, cP, sP
!-------------------------------------------------------------------------------------------
cK = dcos ( Psi )
sK = dsin ( Psi )
cT = dcos ( Tet )
sT = dsin ( Tet )
cP = dcos ( Phi )
sP = dsin ( Phi )
M(0,0) = cP * cK - sK * sP * cT
M(0,1) = cP * sK + sP * cT * cK
M(0,2) = sP * sT
M(1,0) = - sP * cK - cP * cT * sK
M(1,1) = - sP * sK + cP * cT * cK
M(1,2) = cP * sT
M(2,0) = sT * sK
M(2,1) = - sT * cK
M(2,2) = cT
end subroutine RotationMatrix3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine EulerAngles ( Psi, Tet, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: Tet, Psi
real*8, dimension(0:2), intent(in) :: L
!-------------------------------------------------------------------------------------------
Tet = acos ( L(2) )
Psi = atan2 ( L(1), L(0) )
if ( Psi > M_3PI_2 ) then
Psi = Psi - M_3PI_2
else
Psi = Psi + M_PI_2
end if
end subroutine EulerAngles !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! File inout and output
!---------------------------------------------------------------------------------------------------
integer*4 function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
character*(*), intent(in) :: Name, Params, Path
!-------------------------------------------------------------------------------------------
integer*4 :: Fuid
character*512 :: FullName, Msg, Name1, Action1, Status1, Form1, Position1
!-------------------------------------------------------------------------------------------
OpenFile = StdUID + 1
if ( Params(1:1) == 'r' ) then
Action1 = 'read'
Status1 = 'old'
Position1 = 'rewind'
else if ( Params(1:1) == 'w' ) then
Action1 = 'write'
Status1 = 'replace'
Position1 = 'rewind'
else if ( Params(1:1) == 'a' ) then
Action1 = 'write'
Status1 = 'old'
Position1 = 'append'
endif
if ( Params(2:2) == 'b' ) then
Form1 = 'binary'
else
Form1 = 'formatted'
endif
open ( unit = OpenFile, file = Name, form = Form1, action = Action1, status = Status1, position = Position1 )
StdUID = StdUID + 1
return
end function OpenFile !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CloseFile ( Fuid ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4, intent(inout) :: Fuid
!-------------------------------------------------------------------------------------------
if ( Fuid < 0 ) return
close ( unit = Fuid )
Fuid = -1
end subroutine CloseFile !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TPMLib !*********************************************************************************

79
tools/mesont/LinFun2.f90 → tools/mesont/TMDPotGen/LinFun2.f90
View File

@ -1,21 +1,6 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 LinFun2 !************************************************************************************
!
! TMD Library: Bi-linear functions and their derivatives
! Bi-linear functions and their derivatives.
!
!---------------------------------------------------------------------------------------------------
!
@ -24,18 +9,18 @@ module LinFun2 !****************************************************************
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
real(c_double) function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P
real(c_double), dimension(0:N-1), intent(inout) :: F
integer(c_int) :: i1
real(c_double) :: A, A0
real*8 function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P
real*8, dimension(0:N-1), intent(inout) :: F
integer*4 :: i1
real*8 :: A, A0
!-------------------------------------------------------------------------------------------
i1 = i - 1
A0 = ( P(i) - X ) / ( P(i) - P(i1) )
@ -44,13 +29,13 @@ contains !**********************************************************************
end function CalcLinFun1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcLinFun1_1 ( S, Sx1, i, X, N, P, F, Fx ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: S, Sx1
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P
real(c_double), dimension(0:N-1), intent(inout) :: F, Fx
integer(c_int) :: i1
real(c_double) :: A, A0
real*8, intent(out) :: S, Sx1
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P
real*8, dimension(0:N-1), intent(inout) :: F, Fx
integer*4 :: i1
real*8 :: A, A0
!-------------------------------------------------------------------------------------------
i1 = i - 1
A0 = ( P(i) - X ) / ( P(i) - P(i1) )
@ -59,14 +44,14 @@ contains !**********************************************************************
Sx1 = A0 * Fx(i1) + A * Fx(i)
end subroutine CalcLinFun1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function CalcLinFun2_0 ( i, j, X, Y, N1, N2, P1, P2, F ) !!
integer(c_int), intent(in) :: i, j, N1, N2
real(c_double), intent(in) :: X, Y
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F
integer(c_int) :: i1, j1
real(c_double) :: A, A0, B, B0, G, G0
real*8 function CalcLinFun2_0 ( i, j, X, Y, N1, N2, P1, P2, F ) !!
integer*4, intent(in) :: i, j, N1, N2
real*8, intent(in) :: X, Y
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F
integer*4 :: i1, j1
real*8 :: A, A0, B, B0, G, G0
!-------------------------------------------------------------------------------------------
i1 = i - 1
j1 = j - 1
@ -80,14 +65,14 @@ contains !**********************************************************************
end function CalcLinFun2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcLinFun2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fx, Fy ) !!!!!!!!!!!!
real(c_double), intent(out) :: S, Sx1, Sy1
integer(c_int), intent(in) :: i, j, N1, N2
real(c_double), intent(in) :: X, Y
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fx, Fy
integer(c_int) :: i1, j1
real(c_double) :: A, A0, B, B0, G, G0
real*8, intent(out) :: S, Sx1, Sy1
integer*4, intent(in) :: i, j, N1, N2
real*8, intent(in) :: X, Y
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fx, Fy
integer*4 :: i1, j1
real*8 :: A, A0, B, B0, G, G0
!-------------------------------------------------------------------------------------------
i1 = i - 1
j1 = j - 1

35
tools/mesont/TMDPotGen/Makefile Normal file
View File

@ -0,0 +1,35 @@
#---------------------------------------------------------------------------------------------------
#
# This is Makefile for builing the executable TMDPotGen
#
# Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
#
#---------------------------------------------------------------------------------------------------
EXEPATH = .
F90 = ifort
F90FLAGS = -Ofast -mcmodel=medium
#F90 = pgf90
#F90FLAGS = -fast -mcmodel=medium
LDFLAGS =
OBJS = TPMLib.o LinFun2.o Spline1.o Spline2.o TPMGeom.o TubePotBase.o TubePotTrue.o TubePotMono.o TMDPotGen.o
EXE = $(EXEPATH)/TMDPotGen
# compile and load
default:
@echo " "
@echo "Compiling Code of Program TMDPotGen"
@echo "FORTRAN 90"
$(MAKE) $(EXE)
$(EXE): $(OBJS)
$(F90) $(F90FLAGS) $(LDFLAGS) -o $(EXE) $(OBJS)
.SUFFIXES: .f90 .o
.f90.o:
$(F90) $(F90FLAGS) -c $*.f90
clean:
rm -f *.o

97
tools/mesont/Spline1.f90 → tools/mesont/TMDPotGen/Spline1.f90
View File

@ -1,21 +1,6 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 Spline1 !************************************************************************************
!
! TMD Library: One-dimensional cubic spline function
! One-dimensional cubic spline function.
!
!---------------------------------------------------------------------------------------------------
!
@ -24,25 +9,26 @@ module Spline1 !****************************************************************
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
real(c_double) function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1
real(c_double) :: H26, HL, HR
real*8 function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1
real*8 :: H26, HL, HR
!-------------------------------------------------------------------------------------------
H26 = Hi_1 * Hi_1 / 6.0
Hl = X - Xi_1
Hr = Xi - X
ValueSpline1_0 = ( ( Mi_1 * Hr * Hr * Hr + Mi * Hl * Hl * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * Hr + ( Yi - Mi * H26 ) * Hl ) / Hi_1
ValueSpline1_0 = ( ( Mi_1 * Hr * Hr * Hr + Mi * Hl * Hl * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * Hr &
+ ( Yi - Mi * H26 ) * Hl ) / Hi_1
end function ValueSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine ValueSpline1_1 ( S, S1, X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: S, S1
real(c_double), intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1
real(c_double) :: H6, H26, HL, HR, HL2, HR2
real*8, intent(out) :: S, S1
real*8, intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1
real*8 :: H6, H26, HL, HR, HL2, HR2
!-------------------------------------------------------------------------------------------
H6 = Hi_1 / 6.0d+00
H26 = Hi_1 * H6
@ -55,14 +41,11 @@ contains !**********************************************************************
end subroutine ValueSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine sprogonka3 ( N, K0, K1, K2, F, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! K0[i] * X[i-1] + K1[i] * X[I] + K2[i] * X[i+1] = F[i]
! i = 0..(N-1)
!-------------------------------------------------------------------------------------------
integer(c_int), intent(in) :: N
real(c_double), dimension(0:N-1), intent(in) :: K0, K1, K2
real(c_double), dimension(0:N-1), intent(inout) :: F, X
real(c_double) :: D
integer(c_int) :: i
integer*4, intent(in) :: N
real*8, dimension(0:N-1), intent(in) :: K0, K1, K2
real*8, dimension(0:N-1), intent(inout) :: F, X
real*8 :: D
integer*4 :: i
!-------------------------------------------------------------------------------------------
X(0) = F(0) / K1(0)
F(0) = - K2(0) / K1(0)
@ -77,11 +60,11 @@ contains !**********************************************************************
end subroutine sprogonka3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CreateSpline1 ( CL, CR, N, P, F, M, D, K0, K1, K2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: CL, CR, N
real(c_double), dimension (0:N-1), intent(in) :: P, F
real(c_double), dimension (0:N-1), intent(inout):: M, D, K0, K1, K2
integer(c_int) :: i
real(c_double) :: Z
integer*4, intent(in) :: CL, CR, N
real*8, dimension (0:N-1), intent(in) :: P, F
real*8, dimension (0:N-1), intent(inout):: M, D, K0, K1, K2
integer*4 :: i
real*8 :: Z
!-------------------------------------------------------------------------------------------
do i = 1, N - 1
K0(i) = P(i) - P(i-1)
@ -124,12 +107,12 @@ contains !**********************************************************************
call sprogonka3 ( N, K0, K1, K2, D, M )
end subroutine CreateSpline1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P, F, M
integer(c_int) :: j
real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
real*8 function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P, F, M
integer*4 :: j
real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
!-------------------------------------------------------------------------------------------
j = i - 1
HL = X - P(j)
@ -141,16 +124,17 @@ contains !**********************************************************************
HR2 = HR * HR
HLH = HL / H
HRH = HR / H
CalcSpline1_0 = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH
CalcSpline1_0 = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH &
+ ( F(i) - M(i) * H26 ) * HLH
end function CalcSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_1 ( S, S1, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: S, S1
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P, F, M
integer(c_int) :: j
real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
real*8, intent(out) :: S, S1
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P, F, M
integer*4 :: j
real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
!-------------------------------------------------------------------------------------------
j = i - 1
HL = X - P(j)
@ -167,12 +151,12 @@ contains !**********************************************************************
end subroutine CalcSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_2 ( S, S1, S2, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: S, S1, S2
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P, F, M
integer(c_int) :: j
real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
real*8, intent(out) :: S, S1, S2
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P, F, M
integer*4 :: j
real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
!-------------------------------------------------------------------------------------------
j = i - 1
HL = X - P(j)
@ -190,3 +174,4 @@ contains !**********************************************************************
end subroutine CalcSpline1_2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module Spline1 !********************************************************************************

77
tools/mesont/Spline2.f90 → tools/mesont/TMDPotGen/Spline2.f90
View File

@ -1,21 +1,6 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 Spline2 !************************************************************************************
!
! TMD Library: Two-dimensional cubic spline function
! Two-dimensional cubic spline function.
!
!---------------------------------------------------------------------------------------------------
!
@ -26,18 +11,18 @@ module Spline2 !****************************************************************
!***************************************************************************************************
use Spline1
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
subroutine CreateSpline2 ( CL, CD, CR, CU, N1, N2, N, P1, P2, F, Fxx, Fyy, Fxxyy, FF, MM, DD, K0, K1, K2 )
integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N2, N
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
real(c_double), dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2
integer(c_int) :: II
integer*4, intent(in) :: CL, CD, CR, CU, N1, N2, N
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
real*8, dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2
integer*4 :: II
!-------------------------------------------------------------------------------------------
do II = 0, N2 - 1
FF(0:N1-1) = F(0:N1-1,II)
@ -69,12 +54,12 @@ contains !**********************************************************************
end subroutine CreateSpline2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CreateSpline2Ext ( CL, CD, CR, CU, N1, N1A, N2, N2A, N, P1, P2, F, Fxx, Fyy, Fxxyy, FF, MM, DD, K0, K1, K2 )
integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N1A, N2, N2A, N
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
real(c_double), dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2
integer(c_int) :: II
integer*4, intent(in) :: CL, CD, CR, CU, N1, N1A, N2, N2A, N
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
real*8, dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2
integer*4 :: II
!-------------------------------------------------------------------------------------------
Fxx = 0.0d+00
Fyy = 0.0d+00
@ -142,14 +127,14 @@ contains !**********************************************************************
end subroutine CreateSpline2Ext !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function CalcSpline2_0 ( i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!!!!!!!!!
integer(c_int), intent(in) :: i, j, N1, N2
real(c_double), intent(in) :: X, Y
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
integer(c_int) :: i1, j1
real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
real*8 function CalcSpline2_0 ( i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!!!!!!!!!
integer*4, intent(in) :: i, j, N1, N2
real*8, intent(in) :: X, Y
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
integer*4 :: i1, j1
real*8 :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
!-------------------------------------------------------------------------------------------
i1 = i - 1
j1 = j - 1
@ -162,15 +147,15 @@ contains !**********************************************************************
end function CalcSpline2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!
real(c_double), intent(out) :: S, Sx1, Sy1
integer(c_int), intent(in) :: i, j, N1, N2
real(c_double), intent(in) :: X, Y
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
integer(c_int) :: i1, j1
real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
real(c_double) :: Gyy_0, Gyy_1, Gxxyy_0, Gxxyy_1
real*8, intent(out) :: S, Sx1, Sy1
integer*4, intent(in) :: i, j, N1, N2
real*8, intent(in) :: X, Y
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
integer*4 :: i1, j1
real*8 :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
real*8 :: Gyy_0, Gyy_1, Gxxyy_0, Gxxyy_1
!-------------------------------------------------------------------------------------------
i1 = i - 1
j1 = j - 1

62
tools/mesont/TMDPotGen/TMDPotGen.f90 Normal file
View File

@ -0,0 +1,62 @@
program TMDPotGen !*********************************************************************************
!
! Stand-alone generator of files containing tubular potential data for single-walled CNTs.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!***************************************************************************************************
use TubePotMono
implicit none
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
integer*4 :: ChiIndM = 10 ! Chirality index m of nanotubes
integer*4 :: ChiIndN = 10 ! Chirality index n of nanotubes
!---------------------------------------------------------------------------------------------------
! Body
!---------------------------------------------------------------------------------------------------
TPMStartMode = 0
! Reading and printing of governing parameters
call LoadGoverningParameters ()
call PrintGoverningParameters ()
call TPBInit ()
call TPMInit ( ChiIndM, ChiIndN )
contains !------------------------------------------------------------------------------------------
subroutine LoadGoverningParameters () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function reads governing parameters from xdt file
!-------------------------------------------------------------------------------------------
integer*4 :: Fuid, i
character*512 :: Msg
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( 'TMDPotGen.xdt', 'rt', '' )
read ( unit = Fuid, fmt = '(i22)' ) ChiIndM
read ( unit = Fuid, fmt = '(i22)' ) ChiIndN
call CloseFile ( Fuid )
end subroutine LoadGoverningParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine PrintGoverningParameters () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function prints governing parameters to xlg file
!-------------------------------------------------------------------------------------------
integer*4 :: Fuid, i
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( 'TMDPotGen.xlg', 'wt', '' )
write ( unit = Fuid, fmt = '(i22,a)' ) ChiIndM, ' : ChiIndM'
write ( unit = Fuid, fmt = '(i22,a)' ) ChiIndN, ' : ChiIndN'
call CloseFile ( Fuid )
end subroutine PrintGoverningParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end program TMDPotGen !*****************************************************************************

2
tools/mesont/TMDPotGen/TMDPotGen.xdt Normal file
View File

@ -0,0 +1,2 @@
10 : ChiIndM
10 : ChiIndN

144
tools/mesont/TMDPotGen/TPMGeom.f90 Normal file
View File

@ -0,0 +1,144 @@
module TPMGeom !************************************************************************************
!
! Geometry functions for TPM force field.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!***************************************************************************************************
use TPMLib
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
integer*4, parameter :: MD_LINES_NONPAR = 0
integer*4, parameter :: MD_LINES_PAR = 1
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
! Coordinates of the whole domain
real*8 :: DomXmin, DomXmax, DomYmin, DomYmax, DomZmin, DomZmax
real*8 :: DomLX, DomLY, DomLZ
real*8 :: DomLXhalf, DomLYhalf, DomLZhalf
! Boundary conditions
integer*4 :: BC_X = 0
integer*4 :: BC_Y = 0
integer*4 :: BC_Z = 0
! Skin parameter in NBL and related algorithms
real*8 :: Rskin = 1.0d+00
contains !******************************************************************************************
subroutine ApplyPeriodicBC ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This subroutine changes coordinates of the point according to periodic boundary conditions
! it order to make sure that the point is inside the computational cell
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2), intent(inout) :: R
!-------------------------------------------------------------------------------------------
! These commented lines implement the more general, but less efficient algorithm
!if ( BC_X == 1 ) R(0) = R(0) - DomLX * roundint ( R(0) / DomLX )
!if ( BC_Y == 1 ) R(1) = R(1) - DomLY * roundint ( R(1) / DomLY )
!if ( BC_Z == 1 ) R(2) = R(2) - DomLZ * roundint ( R(2) / DomLZ )
if ( BC_X == 1 ) then
if ( R(0) .GT. DomLXHalf ) then
R(0) = R(0) - DomLX
else if ( R(0) .LT. - DomLXHalf ) then
R(0) = R(0) + DomLX
end if
end if
if ( BC_Y == 1 ) then
if ( R(1) .GT. DomLYHalf ) then
R(1) = R(1) - DomLY
else if ( R(1) .LT. - DomLYHalf ) then
R(1) = R(1) + DomLY
end if
end if
if ( BC_Z == 1 ) then
if ( R(2) .GT. DomLZHalf ) then
R(2) = R(2) - DomLZ
else if ( R(2) .LT. - DomLZHalf ) then
R(2) = R(2) + DomLZ
end if
end if
end subroutine ApplyPeriodicBC !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine LinePoint ( Displacement, Q, R1, L1, R0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function calculates the point Q of projection of point R0 on line (R1,L1)
! Q = R1 + Disaplacement * L1
!-------------------------------------------------------------------------------------------
real*8, intent(inout) :: Displacement
real*8, dimension(0:2), intent(inout) :: Q
real*8, dimension(0:2), intent(in) :: R1, L1, R0
!--------------------------------------------------------------------------------------------
Q = R0 - R1
! Here we take into account periodic boundaries
call ApplyPeriodicBC ( Q )
Displacement = S_V3xV3 ( Q, L1 )
Q = R1 + Displacement * L1
end subroutine LinePoint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!!!!!!!
! This function determines the nearest distance H between two lines (R1,L1) and (R2,L2)
!-------------------------------------------------------------------------------------------
! Input values:
! R1, L1, point and direction of line 1
! R2, L2, point and direction of line 2
! Prec, precision for the case L1 * L2 = 0 (parallel lines)
! Return values:
! H, minimal distance between lines
! cosA, cosine of angle between lines
! D1, D2, displacements
! L12, unit vector directed along the closes distance
!-------------------------------------------------------------------------------------------
real*8, intent(inout) :: H, cosA, D1, D2
real*8, dimension(0:2), intent(out) :: L12
real*8, dimension(0:2), intent(in) :: R1, L1, R2, L2
!-------------------------------------------------------------------------------------------
real*8, intent(in) :: Prec
real*8, dimension(0:2) :: Q1, Q2, R
real*8 :: C, DD1, DD2, C1, C2
!-------------------------------------------------------------------------------------------
cosA = S_V3xV3 ( L1, L2 )
C = 1.0 - sqr ( cosA )
if ( C < Prec ) then ! Lines are parallel to each other
LineLine = MD_LINES_PAR
return
end if
LineLine = MD_LINES_NONPAR
R = R2 - R1
! Here we take into account periodic boundaries
call ApplyPeriodicBC ( R )
DD1 = S_V3xV3 ( R, L1 )
DD2 = S_V3xV3 ( R, L2 )
D1 = ( cosA * DD2 - DD1 ) / C
D2 = ( DD2 - cosA * DD1 ) / C
Q1 = R1 - D1 * L1
Q2 = R2 - D2 * L2
L12 = Q2 - Q1
! Here we take into account periodic boundaries
call ApplyPeriodicBC ( L12 )
H = S_V3norm3 ( L12 )
if ( H < Prec ) then ! Lines intersect each other
C1 = signum ( D1 )
C2 = signum ( D1 ) * signum ( cosA )
Q1 = C1 * L1
Q2 = C2 * L2
call V3_V3xxV3 ( L12, Q1, Q2 )
call V3_ort ( L12 )
else ! No intersection
L12 = L12 / H
end if
end function LineLine !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TPMGeom !********************************************************************************

98
tools/mesont/TPMLib.f90 → tools/mesont/TMDPotGen/TPMLib.f90
View File

@ -1,60 +1,45 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 TPMLib !*************************************************************************************
!
! TMD Library: Basic constants, types, and mathematical functions
! Common constants, types, and functions for TPM force field.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!***************************************************************************************************
use iso_c_binding, only : c_int, c_double, c_char
implicit none
!---------------------------------------------------------------------------------------------------
! Mathematical constants
!---------------------------------------------------------------------------------------------------
real(c_double), parameter :: M_PI_2 = 1.57079632679489661923
real(c_double), parameter :: M_PI = 3.14159265358979323846
real(c_double), parameter :: M_3PI_2 = 4.71238898038468985769
real(c_double), parameter :: M_2PI = 6.28318530717958647692
real(c_double), parameter :: M_PI_180 = 0.017453292519943295769
real*8, parameter :: M_PI_2 = 1.57079632679489661923
real*8, parameter :: M_PI = 3.14159265358979323846
real*8, parameter :: M_3PI_2 = 4.71238898038468985769
real*8, parameter :: M_2PI = 6.28318530717958647692
real*8, parameter :: M_PI_180 = 0.017453292519943295769
!---------------------------------------------------------------------------------------------------
! Physical unit constants
!---------------------------------------------------------------------------------------------------
real(c_double), parameter :: K_AMU = 1.66056E-27 ! a.m.u. (atomic mass unit, Dalton)
real(c_double), parameter :: K_EV = 1.60217646e-19 ! eV (electron-volt)
real*8, parameter :: K_AMU = 1.66056E-27 ! a.m.u. (atomic mass unit, Dalton)
real*8, parameter :: K_EV = 1.60217646e-19 ! eV (electron-volt)
real(c_double), parameter :: K_MDLU = 1.0E-10 ! MD length unit (m)
real(c_double), parameter :: K_MDEU = K_EV ! MD energy unit (J)
real(c_double), parameter :: K_MDMU = K_AMU ! MD mass unit (kg)
real(c_double), parameter :: K_MDFU = K_MDEU / K_MDLU ! MD force unit (N)
real(c_double), parameter :: K_MDCU = K_MDEU / K_MDMU ! MD specific heat unit (J/(kg*K))
real*8, parameter :: K_MDLU = 1.0E-10 ! MD length unit (m)
real*8, parameter :: K_MDEU = K_EV ! MD energy unit (J)
real*8, parameter :: K_MDMU = K_AMU ! MD mass unit (kg)
real*8, parameter :: K_MDFU = K_MDEU / K_MDLU ! MD force unit (N)
real*8, parameter :: K_MDCU = K_MDEU / K_MDMU ! MD specific heat unit (J/(kg*K))
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
integer(c_int) :: StdUID = 31
integer*4 :: StdUID = 31
contains !******************************************************************************************
@ -62,20 +47,20 @@ contains !**********************************************************************
! Simple mathematical functions
!---------------------------------------------------------------------------------------------------
real(c_double) function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: X
real*8 function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: X
!-------------------------------------------------------------------------------------------
rad = X * M_PI_180
end function rad !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: X
real*8 function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: X
!-------------------------------------------------------------------------------------------
sqr = X * X
end function sqr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: X
integer*4 function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: X
!-------------------------------------------------------------------------------------------
if ( X > 0 ) then
signum = 1
@ -90,20 +75,20 @@ contains !**********************************************************************
! Vector & matrix functions
!---------------------------------------------------------------------------------------------------
real(c_double) function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), dimension(0:2), intent(in) :: V
real*8 function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, dimension(0:2), intent(in) :: V
!-------------------------------------------------------------------------------------------
S_V3xx = V(0) * V(0) + V(1) * V(1) + V(2) * V(2)
end function S_V3xx !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function S_V3xV3 ( V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), dimension(0:2), intent(in) :: V1, V2
real*8 function S_V3xV3 ( V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, dimension(0:2), intent(in) :: V1, V2
!-------------------------------------------------------------------------------------------
S_V3xV3 = V1(0) * V2(0) + V1(1) * V2(1) + V1(2) * V2(2)
end function S_V3xV3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function S_V3norm3 ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), dimension(0:2), intent(in) :: V
real*8 function S_V3norm3 ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, dimension(0:2), intent(in) :: V
!-------------------------------------------------------------------------------------------
S_V3norm3 = dsqrt ( V(0) * V(0) + V(1) * V(1) + V(2) * V(2) )
end function S_V3norm3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -111,9 +96,9 @@ contains !**********************************************************************
subroutine V3_ort ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Vector production
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2), intent(inout) :: V
real*8, dimension(0:2), intent(inout) :: V
!-------------------------------------------------------------------------------------------
real(c_double) :: Vabs
real*8 :: Vabs
!-------------------------------------------------------------------------------------------
Vabs = S_V3norm3 ( V )
V(0) = V(0) / Vabs
@ -124,8 +109,8 @@ contains !**********************************************************************
subroutine V3_V3xxV3 ( V, V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Vector production
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2), intent(out) :: V
real(c_double), dimension(0:2), intent(in) :: V1, V2
real*8, dimension(0:2), intent(out) :: V
real*8, dimension(0:2), intent(in) :: V1, V2
!-------------------------------------------------------------------------------------------
V(0) = V1(1) * V2(2) - V1(2) * V2(1)
V(1) = V1(2) * V2(0) - V1(0) * V2(2)
@ -139,10 +124,10 @@ contains !**********************************************************************
subroutine RotationMatrix3 ( M, Psi, Tet, Phi ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Ksi, Tet and Phi are Euler angles
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2,0:2), intent(out) :: M
real(c_double), intent(in) :: Psi, Tet, Phi
real*8, dimension(0:2,0:2), intent(out) :: M
real*8, intent(in) :: Psi, Tet, Phi
!-------------------------------------------------------------------------------------------
real(c_double) :: cK, sK, cT, sT, cP, sP
real*8 :: cK, sK, cT, sT, cP, sP
!-------------------------------------------------------------------------------------------
cK = dcos ( Psi )
sK = dsin ( Psi )
@ -162,8 +147,8 @@ contains !**********************************************************************
end subroutine RotationMatrix3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine EulerAngles ( Psi, Tet, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: Tet, Psi
real(c_double), dimension(0:2), intent(in) :: L
real*8, intent(out) :: Tet, Psi
real*8, dimension(0:2), intent(in) :: L
!-------------------------------------------------------------------------------------------
Tet = acos ( L(2) )
Psi = atan2 ( L(1), L(0) )
@ -175,13 +160,13 @@ contains !**********************************************************************
end subroutine EulerAngles !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! File inout and output
! File input and output
!---------------------------------------------------------------------------------------------------
integer(c_int) function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
character*(*), intent(in) :: Name, Params, Path
!-------------------------------------------------------------------------------------------
integer(c_int) :: Fuid
integer*4 :: Fuid
character*512 :: FullName, Msg, Name1, Action1, Status1, Form1, Position1
!-------------------------------------------------------------------------------------------
OpenFile = StdUID + 1
@ -209,7 +194,7 @@ contains !**********************************************************************
end function OpenFile !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CloseFile ( Fuid ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(inout) :: Fuid
integer*4, intent(inout) :: Fuid
!-------------------------------------------------------------------------------------------
if ( Fuid < 0 ) return
close ( unit = Fuid )
@ -217,3 +202,4 @@ contains !**********************************************************************
end subroutine CloseFile !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TPMLib !*********************************************************************************

193
tools/mesont/TubePotBase.f90 → tools/mesont/TMDPotGen/TubePotBase.f90
View File

@ -1,28 +1,12 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 TubePotBase !********************************************************************************
!
! TMD Library: Non-Bonded pair interaction potential and transfer functions for atoms composing
! nanotubes.
! Non-Bonded pair interaction potential and transfer functions for atoms composing nanotubes.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!---------------------------------------------------------------------------------------------------
!
@ -30,15 +14,15 @@ module TubePotBase !************************************************************
! potentials.
!
! It includes definitions of
! -- TPBU, Lennard-Jones (12-6) potential
! -- TPBQ, Transfer function
! -- TPBU, Lennard-Jones (12-6) potential;
! -- TPBQ, Transfer function,
!
! All default values are adjusted for non-bonded carbob-carbon interaction in carbon nanotubes.
! All default values are adjusted for non-bonded carbon-carbon interaction in carbon nanotubes.
!
!***************************************************************************************************
use TPMLib
use iso_c_binding, only : c_int, c_double, c_char
implicit none
!---------------------------------------------------------------------------------------------------
@ -46,87 +30,83 @@ implicit none
!---------------------------------------------------------------------------------------------------
! Types of the potential with respect to the breathing mode
integer(c_int), parameter :: TP_POT_MONO_R = 0
integer(c_int), parameter :: TP_POT_POLY_R = 1
integer*4, parameter :: TP_POT_MONO_R = 0
integer*4, parameter :: TP_POT_POLY_R = 1
! Maximal number of elements in corresponding tables
integer(c_int), parameter :: TPBNMAX = 2001
! Maximum number of elements in corresponding tables
integer*4, parameter :: TPBNMAX = 2001
! Numerical constants
real(c_double), parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5
real*8, parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5
! Mass of C atom
real(c_double), parameter :: TPBMc = 12.0107d+00 ! (Da)
real*8, parameter :: TPBMc = 12.0107d+00 ! (Da)
! Parameters of the Van der Waals inteaction between carbon atoms in graphene sheets, see
! Parameters of the Van der Waals interaction between carbon atoms in graphene sheets, see
! Stuart S.J., Tutein A.B., Harrison J.A., J. Chem. Phys. 112(14), 2000
real(c_double), parameter :: TPBEcc = 0.00284d+00 ! (eV)
real(c_double), parameter :: TPBScc = 3.4d+00 ! (A)
real*8, parameter :: TPBEcc = 0.00284d+00 ! (eV)
real*8, parameter :: TPBScc = 3.4d+00 ! (A)
! Lattice parameter and numerical density of atoms for a graphene sheet, see
! Lattice parameter and surface number density of atoms for a graphene sheet, see
! Dresselhaus et al, Carbon 33(7), 1995
real(c_double), parameter :: TPBAcc = 1.421d+00 ! (A)
real(c_double), parameter :: TPBDcc = 4.0d+00 / ( TPBConstD * TPBAcc * TPBAcc ) ! (1/A^2)
real*8, parameter :: TPBAcc = 1.421d+00 ! (A)
real*8, parameter :: TPBDcc = 4.0d+00 / ( TPBConstD * TPBAcc * TPBAcc ) ! (1/A^2)
! Specific heat of carbon nanotubes
real(c_double), parameter :: TPBSHcc = 600.0d+00 / K_MDCU ! (eV/(Da*K))
real*8, parameter :: TPBSHcc = 600.0d+00 / K_MDCU ! (eV/(Da*K))
! Cutoff distances for interactomic potential and transfer function
! Cutoff distances for interactomic potential and transfer function.
! Changes in these parameters can result in necessity to change some numerical parameters too.
real(c_double), parameter :: TPBRmincc = 0.001d+00 * TPBScc ! (A)
real(c_double), parameter :: TPBRcutoffcc = 3.0d+00 * TPBScc ! (A)
real(c_double), parameter :: TPBRcutoff1cc = 2.16d+00 * TPBScc ! (A)
real*8, parameter :: TPBRmincc = 0.001d+00 * TPBScc ! (A)
real*8, parameter :: TPBRcutoffcc = 3.0d+00 * TPBScc ! (A)
real*8, parameter :: TPBRcutoff1cc = 2.16d+00 * TPBScc ! (A)
! Parameters of the transfer function for non-bonded interaction between carbon atoms
!real(c_double), parameter :: TPBQScc = TPBScc ! (A)
!real(c_double), parameter :: TPBQRcutoff1cc = 2.16d+00 * TPBScc ! (A)
real(c_double), parameter :: TPBQScc = 7.0d+00 ! (A)
real(c_double), parameter :: TPBQRcutoff1cc = 8.0d+00 ! (A)
real*8, parameter :: TPBQScc = 7.0d+00 ! (A)
real*8, parameter :: TPBQRcutoff1cc = 8.0d+00 ! (A)
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
logical :: TPErrCheck = .true. ! Set to .true. to generate diagnostic and warning messages
character*512 :: TPErrMsg = '' ! Typically, this variable is set up in F_tt ()
logical :: TPErrCheck = .true. ! Set to .true. to generate diagnostic and warning messages
character*512 :: TPErrMsg = ''
real(c_double) :: TPGeomPrec = 1.0d-06 ! Geometric precision, see TPInt
integer(c_int) :: TPPotType = TP_POT_MONO_R ! Type of the potential with respect to the breathing mode
real*8 :: TPGeomPrec = 1.0d-06 ! Geometric precision, see TPInt
integer*4 :: TPPotType = TP_POT_MONO_R ! Type of the potential with respect to the breathing mode
! Physical parameters of the interatomic potential and atoms distribution at the surface
! of the tube
! Parameters of the interatomic potential and atoms distribution at the nanotube surface
real(c_double) :: TPBM = TPBMc ! Mass of an atom, Da
real(c_double) :: TPBE = TPBEcc ! Depth of the energy well in LJ (12-6) interatomic potential (eV)
real(c_double) :: TPBS = TPBScc ! Sigma parameter of LJ (12-6) interatomic potential (A)
real(c_double) :: TPBD = TPBDcc ! Numerical density of atoms at the tube surface (1/A^2)
real(c_double) :: TPBSH = TPBSHcc ! Specific heat (eV/(Da*K))
real*8 :: TPBM = TPBMc ! Mass of an atom (Da)
real*8 :: TPBE = TPBEcc ! Depth of the energy well in (12-6) LJ interatomic potential (eV)
real*8 :: TPBS = TPBScc ! Sigma parameter of (12-6) LJ interatomic potential (A)
real*8 :: TPBD = TPBDcc ! Numerical density of atoms at the tube surface (1/A^2)
real*8 :: TPBSH = TPBSHcc ! Specific heat (eV/(Da*K))
real(c_double) :: TPBRmin = TPBRmincc ! (A)
real(c_double) :: TPBRcutoff = TPBRcutoffcc ! (A)
real(c_double) :: TPBRcutoff1 = TPBRcutoff1cc ! (A)
real*8 :: TPBRmin = TPBRmincc ! (A)
real*8 :: TPBRcutoff = TPBRcutoffcc ! (A)
real*8 :: TPBRcutoff1 = TPBRcutoff1cc ! (A)
! Physical parameters of the transfer function
real(c_double) :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A)
real(c_double) :: TPBQRcutoff1 = TPBQRcutoff1cc ! (A)
real*8 :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A)
real*8 :: TPBQRcutoff1 = TPBQRcutoff1cc ! (A)
! Auxilary variables
! Auxiliary variables
real(c_double) :: TPBE4, TPBE24, TPBDRcutoff, TPBQDRcutoff
real(c_double) :: TPBQR0 ! Constant-value distance for the transfer function (A)
real*8 :: TPBE4, TPBE24, TPBDRcutoff, TPBQDRcutoff
real*8 :: TPBQR0 ! Constant-value distance for the transfer function (A)
! Table of inter-particle potential, force, and transfer function
integer(c_int) :: TPBN = TPBNMAX
real(c_double) :: TPBDR
real(c_double), dimension(0:TPBNMAX-1) :: TPBQ
real(c_double), dimension(0:TPBNMAX-1) :: TPBU, TPBdUdR
integer*4 :: TPBN = TPBNMAX
real*8 :: TPBDR
real*8, dimension(0:TPBNMAX-1) :: TPBQ
real*8, dimension(0:TPBNMAX-1) :: TPBU, TPBdUdR
contains !******************************************************************************************
integer(c_int) function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!TPBsizeof = sizeof ( TPBU ) + sizeof ( TPBdUdR )
integer*4 function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TPBsizeof = 8 * ( size ( TPBQ ) + size ( TPBU ) + size ( TPBdUdR ) )
end function TPBsizeof !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -134,11 +114,11 @@ contains !**********************************************************************
! Interpolation
!---------------------------------------------------------------------------------------------------
real(c_double) function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R
real*8 function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, RR
integer(c_int) :: i
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
@ -155,11 +135,11 @@ contains !**********************************************************************
TPBQInt0 = TPBQ(i) * Z + TPBQ(i+1) * RR
end function TPBQInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R
real*8 function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, RR
integer(c_int) :: i
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
@ -177,11 +157,11 @@ contains !**********************************************************************
end function TPBUInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBUInt1 ( U, dUdR, R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: U, dUdR
real(c_double), intent(in) :: R
real*8, intent(out) :: U, dUdR
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, RR
integer(c_int) :: i
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
@ -204,10 +184,10 @@ contains !**********************************************************************
! Calculation
!---------------------------------------------------------------------------------------------------
real(c_double) function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R
real*8 function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, t, S
real*8 :: Z, t, S
!-------------------------------------------------------------------------------------------
if ( R > TPBRcutoff ) then
TPBQCalc0 = 0.0d+00
@ -226,10 +206,10 @@ contains !**********************************************************************
endif
end function TPBQCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R
real*8 function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, t, S
real*8 :: Z, t, S
!-------------------------------------------------------------------------------------------
if ( R > TPBRcutoff ) then
TPBUCalc0 = 0.0d+00
@ -247,9 +227,9 @@ contains !**********************************************************************
end function TPBUCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBUCalc1 ( U, dUdR, R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: U, dUdR
real(c_double), intent(in) :: R
real(c_double) :: Z, t, S, dSdR
real*8, intent(out) :: U, dUdR
real*8, intent(in) :: R
real*8 :: Z, t, S, dSdR
!-------------------------------------------------------------------------------------------
if ( R > TPBRcutoff ) then
U = 0.0d+00
@ -271,11 +251,11 @@ contains !**********************************************************************
end subroutine TPBUCalc1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBSegmentForces ( F1, F2, F, M, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), dimension(0:2), intent(out) :: F1, F2
real(c_double), dimension(0:2), intent(in) :: F, M, Laxis
real(c_double), intent(in) :: L
real*8, dimension(0:2), intent(out) :: F1, F2
real*8, dimension(0:2), intent(in) :: F, M, Laxis
real*8, intent(in) :: L
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2) :: FF, MM, FFF
real*8, dimension(0:2) :: FF, MM, FFF
!-------------------------------------------------------------------------------------------
FF = 0.5d+00 * F
MM = M / L
@ -284,36 +264,13 @@ contains !**********************************************************************
F2 = FF + FFF
end subroutine TPBSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Printing
!---------------------------------------------------------------------------------------------------
! subroutine TPBPrint ( FileName ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! character(c_char)*(*), intent(in) :: FileName
! !-------------------------------------------------------------------------------------------
! integer(c_int) :: Fuid
! integer(c_int) :: i
! real(c_double) :: R
! !-------------------------------------------------------------------------------------------
! Fuid = OpenFile ( FileName, "wt", outputpath )
! write ( Fuid, '(a)' ) 'TITLE="TPB Potentials"'
! write ( Fuid, '(a)' ) 'VARIABLES="R" "Q" "U" "dUdR"'
! write ( Fuid, '(a)' ) 'ZONE'
! R = TPBRmin
! do i = 0, TPBN - 1
! write ( Fuid, '(4e22.12)' ) R, TPBQ(i), TPBU(i), TPBDUDR(i)
! R = R + TPBDR
! end do
! call CloseFile ( Fuid )
! end subroutine TPBPrint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Initialization
!---------------------------------------------------------------------------------------------------
subroutine TPBInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) :: R
integer(c_int) :: i
real*8 :: R
integer*4 :: i
!-------------------------------------------------------------------------------------------
TPBE4 = 4.0d+00 * TPBE
TPBE24 = - 24.0d+00 * TPBE

694
tools/mesont/TubePotMono.f90 → tools/mesont/TMDPotGen/TubePotMono.f90
View File

File diff suppressed because it is too large Load Diff

178
tools/mesont/TubePotTrue.f90 → tools/mesont/TMDPotGen/TubePotTrue.f90
View File

@ -1,27 +1,6 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 TubePotTrue !********************************************************************************
!
! TMD Library: True tubular potential and transfer function
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
! True tubular potential and transfer function
!
!---------------------------------------------------------------------------------------------------
!
@ -29,33 +8,39 @@ module TubePotTrue !************************************************************
! between two cylinder segments of nanotubes by direct integration over the surfaces of both
! segments.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!***************************************************************************************************
use TPMGeom
use TubePotBase
use iso_c_binding, only : c_int, c_double, c_char
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
integer(c_int), parameter :: TPTNXMAX = 257
integer(c_int), parameter :: TPTNEMAX = 128
integer*4, parameter :: TPTNXMAX = 257
integer*4, parameter :: TPTNEMAX = 128
!---------------------------------------------------------------------------------------------------
! Types
!---------------------------------------------------------------------------------------------------
type TPTSEG !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) :: X, Y, Z
real(c_double) :: Psi, Theta, Phi ! Euler's angles
real(c_double) :: R ! Segment radius
real(c_double) :: L ! Segment length
integer(c_int) :: NX, NE ! Number of nodes for numerical integration
real(c_double) :: DX, DE ! Spacings
real(c_double), dimension(0:2,0:2) :: M ! Transformation matrix
real(c_double), dimension(0:TPTNXMAX-1,0:TPTNXMAX-1,0:2) :: Rtab! Node coordinates
real*8 :: X, Y, Z
real*8 :: Psi, Theta, Phi ! Euler's angles
real*8 :: R ! Segment radius
real*8 :: L ! Segment length
integer*4 :: NX, NE ! Number of nodes for numerical integration
real*8 :: DX, DE ! Spacings
real*8, dimension(0:2,0:2) :: M ! Transformation matrix
real*8, dimension(0:TPTNXMAX-1,0:TPTNXMAX-1,0:2) :: Rtab! Node coordinates
end type TPTSEG !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
@ -68,17 +53,17 @@ contains !**********************************************************************
subroutine TPTSegAxisVector ( S, Laxis ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
real(c_double), dimension(0:2), intent(out) :: Laxis
real*8, dimension(0:2), intent(out) :: Laxis
!-------------------------------------------------------------------------------------------
Laxis(0:2) = S%M(2,0:2)
end subroutine TPTSegAxisVector !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTSegRadVector ( S, Lrad, Eps ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
real(c_double), dimension(0:2), intent(out) :: Lrad
real(c_double), intent(in) :: Eps
real*8, dimension(0:2), intent(out) :: Lrad
real*8, intent(in) :: Eps
!-------------------------------------------------------------------------------------------
real(c_double) :: Ce, Se
real*8 :: Ce, Se
!-------------------------------------------------------------------------------------------
Ce = cos ( Eps )
Se = sin ( Eps )
@ -89,10 +74,10 @@ contains !**********************************************************************
subroutine TPTRadiusVector ( S, R, X, Eps ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
real(c_double), dimension(0:2), intent(out) :: R
real(c_double), intent(in) :: X, Eps
real*8, dimension(0:2), intent(out) :: R
real*8, intent(in) :: X, Eps
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2) :: Laxis, Lrad
real*8, dimension(0:2) :: Laxis, Lrad
!-------------------------------------------------------------------------------------------
call TPTSegAxisVector ( S, Laxis )
call TPTSegRadVector ( S, Lrad, Eps )
@ -104,8 +89,8 @@ contains !**********************************************************************
subroutine TPTCalcSegNodeTable ( S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
!-------------------------------------------------------------------------------------------
real(c_double) :: X, Eps
integer(c_int) :: i, j
real*8 :: X, Eps
integer*4 :: i, j
!-------------------------------------------------------------------------------------------
X = - S%L / 2.0
call RotationMatrix3 ( S%M, S%Psi, S%Theta, S%Phi )
@ -121,8 +106,8 @@ contains !**********************************************************************
subroutine TPTSetSegPosition1 ( S, Rcenter, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
real(c_double), dimension(0:2), intent(in) :: Rcenter, Laxis
real(c_double), intent(in) :: L
real*8, dimension(0:2), intent(in) :: Rcenter, Laxis
real*8, intent(in) :: L
!-------------------------------------------------------------------------------------------
S%L = L
S%DX = L / ( S%NX - 1 )
@ -136,10 +121,10 @@ contains !**********************************************************************
subroutine TPTSetSegPosition2 ( S, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
real(c_double), dimension(0:2), intent(in) :: R1, R2
real*8, dimension(0:2), intent(in) :: R1, R2
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2) :: R, Laxis
real(c_double) :: L
real*8, dimension(0:2) :: R, Laxis
real*8 :: L
!-------------------------------------------------------------------------------------------
R = 0.5 * ( R1 + R2 )
Laxis = R2 - R1
@ -148,12 +133,12 @@ contains !**********************************************************************
call TPTSetSegPosition1 ( S, R, Laxis, L )
end subroutine TPTSetSegPosition2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S1, S2
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
real(c_double) :: L1, L2, Displacement, D
real(c_double), dimension(0:2) :: Laxis, Q, R
integer*4 :: i, j
real*8 :: L1, L2, Displacement, D
real*8, dimension(0:2) :: Laxis, Q, R
!-------------------------------------------------------------------------------------------
L2 = S1%L / 2.0
L1 = - L2
@ -164,7 +149,8 @@ contains !**********************************************************************
do i = 0, S2%NX - 1
do j = 0, S2%NE - 1
call LinePoint ( Displacement, Q, R, Laxis, S2%Rtab(i,j,0:2) )
D = sqrt ( sqr ( Q(0) - S2%Rtab(i,j,0) ) + sqr ( Q(1) - S2%Rtab(i,j,1) ) + sqr ( Q(2) - S2%Rtab(i,j,2) ) )
D = sqrt ( sqr ( Q(0) - S2%Rtab(i,j,0) ) + sqr ( Q(1) - S2%Rtab(i,j,1) ) &
+ sqr ( Q(2) - S2%Rtab(i,j,2) ) )
if ( Displacement > L1 .and. Displacement < L2 .and. D < S1%R ) then
TPTCheckIntersection = 1
return
@ -174,13 +160,13 @@ contains !**********************************************************************
TPTCheckIntersection = 0
end function TPTCheckIntersection !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
real(c_double), intent(out) :: Xmin, Xmax
real(c_double), dimension(0:2), intent(in) :: Re
real*8, intent(out) :: Xmin, Xmax
real*8, dimension(0:2), intent(in) :: Re
!-------------------------------------------------------------------------------------------
real(c_double) :: Displacement, Distance
real(c_double), dimension(0:2) :: Laxis, Q, R
real*8 :: Displacement, Distance
real*8, dimension(0:2) :: Laxis, Q, R
!-------------------------------------------------------------------------------------------
call TPTSegAxisVector ( S, Laxis )
R(0) = S%X
@ -201,8 +187,8 @@ contains !**********************************************************************
end function TPTCalcPointRange !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTGetEnds ( R1_1, R1_2, R2_1, R2_2, X1_1, X1_2, X2_1, X2_2, H, A ) !!!!!!!!!!!!!
real(c_double), dimension(0:2), intent(out) :: R1_1, R1_2, R2_1, R2_2
real(c_double), intent(in) :: X1_1, X1_2, X2_1, X2_2, H, A
real*8, dimension(0:2), intent(out) :: R1_1, R1_2, R2_1, R2_2
real*8, intent(in) :: X1_1, X1_2, X2_1, X2_2, H, A
!-------------------------------------------------------------------------------------------
R1_1(0) = 0.0d+00
R1_1(1) = 0.0d+00
@ -222,19 +208,19 @@ contains !**********************************************************************
! Tubular potential
!---------------------------------------------------------------------------------------------------
integer(c_int) function TPTPointPotential ( Q, U, F, R, S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function TPTPointPotential ( Q, U, F, R, S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the potential U and force F applied to the atom in position R and
! produced by the segment S.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), dimension(0:2), intent(out) :: F
real(c_double), dimension(0:2), intent(in) :: R
real*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F
real*8, dimension(0:2), intent(in) :: R
type(TPTSEG), intent(in) :: S
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
real(c_double), dimension(0:2) :: RR, FF
real(c_double) :: QQ, UU, UUU, FFF, Rabs
real(c_double) :: Coeff, Xmin, Xmax, X
integer*4 :: i, j
real*8, dimension(0:2) :: RR, FF
real*8 :: QQ, UU, UUU, FFF, Rabs
real*8 :: Coeff, Xmin, Xmax, X
!-------------------------------------------------------------------------------------------
TPTPointPotential = 0
Q = 0.0d+00
@ -277,19 +263,19 @@ contains !**********************************************************************
F = F * Coeff
end function TPTPointPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTSectionPotential ( Q, U, F, M, S, i, Ssource ) !!!!!!!!!!!!!!!!!!!!!!!
! This funcion returns the potential U, force F and torque M produced by the segment Ssource
integer*4 function TPTSectionPotential ( Q, U, F, M, S, i, Ssource ) !!!!!!!!!!!!!!!!!!!!!!!
! This function returns the potential U, force F and torque M produced by the segment Ssource
! and applied to the i-th circular cross-section of the segment S.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), dimension(0:2), intent(out) :: F, M
real*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F, M
type(TPTSEG), intent(in) :: S, Ssource
integer(c_int), intent(in) :: i
integer*4, intent(in) :: i
!-------------------------------------------------------------------------------------------
integer(c_int) :: j
real(c_double), dimension(0:2) :: R, Fp, Mp, Lrad
real(c_double) :: Qp, Up, Eps
real(c_double) :: Coeff
integer*4 :: j
real*8, dimension(0:2) :: R, Fp, Mp, Lrad
real*8 :: Qp, Up, Eps
real*8 :: Coeff
!-------------------------------------------------------------------------------------------
TPTSectionPotential = 0
Q = 0.0d+00
@ -319,16 +305,16 @@ contains !**********************************************************************
M = M * Coeff
end function TPTSectionPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTSegmentPotential ( Q, U, F, M, S, Ssource ) !!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function TPTSegmentPotential ( Q, U, F, M, S, Ssource ) !!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the potential U, force F and torque M produced by the segment
! Ssource and applied to the segment S.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), dimension(0:2), intent(out) :: F, M
real*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F, M
type(TPTSEG), intent(in) :: S, Ssource
integer(c_int) :: i
real(c_double), dimension(0:2) :: Fc, Mc
real(c_double) :: Qc, Uc
integer*4 :: i
real*8, dimension(0:2) :: Fc, Mc
real*8 :: Qc, Uc
!-------------------------------------------------------------------------------------------
TPTSegmentPotential = 0
Q = 0.0d+00
@ -366,11 +352,11 @@ contains !**********************************************************************
!---------------------------------------------------------------------------------------------------
subroutine TPTSegmentForces ( F1, F2, F, M, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), dimension(0:2), intent(out) :: F1, F2
real(c_double), dimension(0:2), intent(in) :: F, M, Laxis
real(c_double), intent(in) :: L
real*8, dimension(0:2), intent(out) :: F1, F2
real*8, dimension(0:2), intent(in) :: F, M, Laxis
real*8, intent(in) :: L
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2) :: MM, FF, FFF
real*8, dimension(0:2) :: MM, FF, FFF
!-------------------------------------------------------------------------------------------
FF = 0.5d+00 * F
MM = M / L
@ -379,15 +365,15 @@ contains !**********************************************************************
F2 = FF + FFF
end subroutine TPTSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2 )
! This function returns the potential and forces appliend to the ends of segments.
integer*4 function TPTInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2 )
! This function returns the potential and forces applied to the ends of segments.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), dimension(0:2), intent(out) :: F1_1, F1_2, F2_1, F2_2
real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2
real*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F1_1, F1_2, F2_1, F2_2
real*8, dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, DR, F1, M1, F2, M2
real(c_double) :: L1, L2
real*8, dimension(0:2) :: R1, R2, Laxis1, Laxis2, DR, F1, M1, F2, M2
real*8 :: L1, L2
!-------------------------------------------------------------------------------------------
R1 = 0.5 * ( R1_1 + R1_2 )
R2 = 0.5 * ( R2_1 + R2_2 )
@ -414,8 +400,8 @@ contains !**********************************************************************
!---------------------------------------------------------------------------------------------------
subroutine TPTInit ( R1, R2, NX, NE ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R1, R2
integer(c_int), intent(in) :: NX, NE
real*8, intent(in) :: R1, R2
integer*4, intent(in) :: NX, NE
!-------------------------------------------------------------------------------------------
TPTSeg1%X = 0.0d+00
TPTSeg1%Y = 0.0d+00
@ -439,4 +425,4 @@ contains !**********************************************************************
TPTSeg2%DE = M_2PI / NE
end subroutine TPTInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TubePotTrue !****************************************************************************
end module TubePotTrue !****************************************************************************

290
tools/mesont/TPMForceField.f90
View File

@ -1,290 +0,0 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 !************************************************************************************
!
! TMD Library: Calculation of the TMD force field
!
!---------------------------------------------------------------------------------------------------
!
! PGI Fortran, Intel Fortran
!
! Alexey N. Volkov, University of Alabama (avolkov1@ua.edu), Version 09.01.33, 2018
!
!***************************************************************************************************
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 ) !!!!!!!!!!!
real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes
real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: L12 ! Equilubrium length of segment (X1,X2)
!-------------------------------------------------------------------------------------------
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 )
real(c_double), intent(inout) :: U1, U2, U3 ! Interaction energies associated with nodes X1, X2, and X3
real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3 ! Forces exerted on nodes X1, X2, and X3
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3 ! Contributions of nodes X1, X2, and X3 to the virial stress tensor
real(c_double), intent(in), dimension(0:2) :: X1, X2, X3 ! Coordinates of nodes
real(c_double), intent(in) :: R123 ! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: L123 ! Equilubrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments)
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 nergies and componets of the virial stress tensor) between a segment
! (X1,X2) and a sequence of segments with node coordinates that 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 appearence in the nanotube
! It means that (X(i),X(i+1)) are either correspond to a real segment or divided by a segments
! that do not belong to a nanotube.
! Concept of the extendend chain:
! Let's consider a sequant of nodes (X1,X2,...,XN) forming continuous part of a nanotube.
! If node Xe preceeds 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, extended chain coincides with (X1,...,XN) and Ee = 0
! If the extended chain contains additional node, then non-zero force is exterted 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 )
integer(c_int), intent(in) :: N ! Number of nodes in array X
real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout), dimension(0:N-1) :: U ! Interaction energies associated with nodes X
real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2,0:N-1) :: F ! Forces exerted on nodes X
real(c_double), intent(inout), dimension(0:2) :: Fe ! Force exerted on node Xe (can be updated only if Ee > 0)
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S ! Contributions of nodes X to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: Se ! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0)
real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes
real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in), dimension(0:2,0:N-1) :: X ! Coordinates of the nanotube nodes
real(c_double), intent(in), dimension(0:2) :: Xe ! Additiona node of the extended chain if Ee > 0
integer(c_int), intent(in), dimension(0:N-1) :: BBF ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i)
real(c_double), intent(in) :: R ! Radius of nanotube X
integer(c_int), intent(in) :: E1, E2 ! E1 = 1 if the chnane node 0 is a CNT end; E1 = 2 if the chnane node N-1 is a CNT end;
integer(c_int), intent(in) :: Ee ! Parameter defining the type of the extended chain (0,1,2)
integer(c_int), intent(in) :: TPMType ! Type of the tubular potential (0 or 1)
!-------------------------------------------------------------------------------------------
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
real(c_double) :: xU1, xU2 ! Interaction energies associated with nodes X1 and X2
real(c_double), dimension(0:N-1) :: xU ! Interaction energies associated with nodes X
real(c_double), dimension(0:2) :: xF1, xF2 ! Forces exerted on nodes X1 and X2
real(c_double), dimension(0:2,0:N-1) :: xF ! Forces exerted on nodes X
real(c_double), dimension(0:2) :: xFe ! Force exerted on node Xe (can be updated only if Ee > 0)
!-------------------------------------------------------------------------------------------
!U1 = 0.0d+00
!U2 = 0.0d+00
!U = 0.0d+00
!F1 = 0.0d+00
!F2 = 0.0d+00
!F = 0.0d+00
!S1 = 0.0d+00
!S2 = 0.0d+00
!S = 0.0d+00
! 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 ! First node in the chain is the tube end
EType1 = .true.
else
EType1 = .false.
end if
if ( E2 == 1 ) then ! 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 ! First node in the extended chain is the tube end
EType = 3
else if ( Ee == 2 ) then ! 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 !**************************************************************************

195
tools/mesont/TPMM0.f90
View File

@ -1,195 +0,0 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 TPMM0 !**************************************************************************************
!
! TMD Library: Combined/Weighted potential of type 0
!
! Direct application of SST potential to calculation of segment-segment interaction
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
!use TMDCounters
use TubePotMono
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
integer(c_int) function TPMInteractionFSS ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2, EType )
real(c_double), intent(inout) :: Q, U
real(c_double), dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2
real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2
integer(c_int), intent(in) :: EType
!-------------------------------------------------------------------------------------------
real(c_double) :: Qa, Ua, Fd, L2
real(c_double), dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a, R2_3, R2, Laxis2, F
integer(c_int) :: IntSign
!-------------------------------------------------------------------------------------------
! C_TPM_4 = C_TPM_4 + 1
R2 = 0.5d+00 * ( R2_1 + R2_2 )
Laxis2 = R2_2 - R2_1
L2 = S_V3norm3 ( Laxis2 )
Laxis2 = Laxis2 / L2
if ( EType < 2 ) then
TPMInteractionFSS = TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, 1 )
R2_3 = R2_2 + R2_2 - R2_1
IntSign = TPMInteractionF ( Qa, Ua, F1_1a, F1_2a, F2_1a, F2_2a, Fd, R1_1, R1_2, R2_2, R2_3, 1 )
if ( IntSign > 0 ) then
TPMInteractionFSS = 1
call TPMSegmentForces ( F2_1a, F2_2a, F1_1a, F1_2a, R1_1, R1_2, R2, Laxis2, L2 )
F = ( Fd - S_V3xV3 ( F2_2a, Laxis2 ) ) * Laxis2
F2_2a = F2_2a + F
F2_1a = F2_1a - F
end if
else
TPMInteractionFSS = TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, 2 )
R2_3 = R2_1 + R2_1 - R2_2
IntSign = TPMInteractionF ( Qa, Ua, F1_1a, F1_2a, F2_1a, F2_2a, Fd, R1_1, R1_2, R2_1, R2_3, 1 )
if ( IntSign > 0 ) then
TPMInteractionFSS = 1
call TPMSegmentForces ( F2_1a, F2_2a, F1_1a, F1_2a, R1_1, R1_2, R2, Laxis2, L2 )
F = ( - Fd - S_V3xV3 ( F2_1a, Laxis2 ) ) * Laxis2
F2_1a = F2_1a + F
F2_2a = F2_2a - F
end if
end if
if ( IntSign > 0 ) then
Q = Q - Qa
if ( Q < 0.0d+00 ) Q = 0.0d+00
U = U - Ua
F2_1 = F2_1 - F2_1a
F2_2 = F2_2 - F2_2a
F1_1 = F1_1 - F1_1a
F1_2 = F1_2 - F1_2a
end if
end function TPMInteractionFSS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMInteractionFW0 ( QQ, U, U1, U2, UU, F1, F2, F, G1, G2, R1, R2, N, NMAX, R )
real(c_double), intent(inout) :: U, U1, U2
integer(c_int), intent(in) :: N, NMAX
real(c_double), dimension(0:NMAX-1), intent(out) :: QQ, UU
real(c_double), dimension(0:2), intent(out) :: F1, F2
real(c_double), dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2
real(c_double), dimension(0:2), intent(in) :: R1, R2
real(c_double), dimension(0:2,0:NMAX-1), intent(in) :: R
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, SType2, GeomID, EType
real(c_double) :: Ua
real(c_double), dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a
real(c_double), dimension(0:2) :: R1a, R2a, Laxis1, Laxis2, L12, DR
real(c_double) :: L1, L2, D1, D2, H, cosA, D, Dmina, Dminb
!-------------------------------------------------------------------------------------------
QQ = 0.0d+00
U = 0.0d+00
U1 = 0.0d+00
U2 = 0.0d+00
UU = 0.0d+00
F1 = 0.0d+00
F2 = 0.0d+00
F = 0.0d+00
G1 = 0.0d+00
G2 = 0.0d+00
TPMInteractionFW0 = 0
do i = 0, N - 2
R1a = 0.5d+00 * ( R1 + R2 )
R2a = 0.5d+00 * ( R(0:2,i+1) + R(0:2,i) )
Laxis1 = R2 - R1
Laxis2 = R(0:2,i+1) - R(0:2,i)
L1 = S_V3norm3 ( Laxis1 )
L2 = S_V3norm3 ( Laxis2 )
Laxis1 = Laxis1 / L1
Laxis2 = Laxis2 / L2
L2 = 0.5d+00 * L2
L1 = 0.5d+00 * L1
GeomID = LineLine ( H, cosA, D1, D2, L12, R1a, Laxis1, R2a, Laxis2, TPGeomPrec )
DR = R1 - R(0:2,i)
call ApplyPeriodicBC ( DR )
Dmina = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
DR = R2 - R(0:2,i)
call ApplyPeriodicBC ( DR )
D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
if ( D < Dmina ) Dmina = D
if ( GeomID == MD_LINES_NONPAR ) then
D = ( D2 - L2 ) * cosA
if ( D > D1 - L1 .and. D < D1 + L1 ) then
D = sqr ( D2 - L2 ) * ( 1.0d+00 - sqr ( cosA ) ) + sqr ( H )
if ( D < Dmina ) Dmina = D
end if
else
call LinePoint ( D, DR, R1, Laxis1, R(0:2,i) )
if ( D > 0.0d+00 .and. D < 2.0d+00 * L1 ) then
DR = DR - R(0:2,i)
call ApplyPeriodicBC ( DR )
D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
if ( D < Dmina ) Dmina = D
end if
end if
DR = R1 - R(0:2,i+1)
call ApplyPeriodicBC ( DR )
Dminb = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
DR = R2 - R(0:2,i+1)
call ApplyPeriodicBC ( DR )
D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
if ( D < Dminb ) Dminb = D
if ( GeomID == MD_LINES_NONPAR ) then
D = ( D2 + L2 ) * cosA
if ( D > D1 - L1 .and. D < D1 + L1 ) then
D = sqr ( D2 + L2 ) * ( 1.0d+00 - sqr ( cosA ) ) + sqr ( H )
if ( D < Dminb ) Dminb = D
end if
else
call LinePoint ( D, DR, R1, Laxis1, R(0:2,i+1) )
if ( D > 0.0d+00 .and. D < 2.0d+00 * L1 ) then
DR = DR - R(0:2,i+1)
call ApplyPeriodicBC ( DR )
D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
if ( D < Dminb ) Dminb = D
end if
end if
if ( Dmina < Dminb ) then
EType = 1
else
EType = 2
end if
if ( TPMInteractionFSS ( QQ(i), Ua, F1_1a, F1_2a, F2_1a, F2_2a, R1, R2, R(0:2,i), R(0:2,i+1), EType ) > 0 ) then
TPMInteractionFW0 = 1
U = U + Ua
Ua = 0.25d+00 * Ua
U1 = U1 + Ua
U2 = U2 + Ua
UU(i) = UU(i) + Ua
UU(i+1) = UU(i+1) + Ua
F1 = F1 + F1_1a
F2 = F2 + F1_2a
F(0:2,i) = F(0:2,i) + F2_1a
F(0:2,i+1) = F(0:2,i+1) + F2_2a
G2(0:2,i) = F2_1a
G1(0:2,i+1) = F2_2a
end if
end do
end function TPMInteractionFW0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TPMM0 !**********************************************************************************

379
tools/mesont/TPMM1.f90
View File

@ -1,379 +0,0 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, 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 TPMM1 !**************************************************************************************
!
! TMD Library: Combined/Weighted potential of type 3
!
! Weighting functions are the same as in potential of type 2.
! Calculation of the combined potential is based on the 'extended' chain.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran.
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
!use TMDCounters
use TubePotMono
use iso_c_binding, only : c_int, c_double, c_char
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
! Maximal length of a segment chain
integer(c_int), parameter :: TPM_MAX_CHAIN = 100
!---------------------------------------------------------------------------------------------------
! Numerical parameters
!---------------------------------------------------------------------------------------------------
! Switching parameters
real(c_double) :: TPMC123 = 1.0d+00 ! Non-dimensional
real(c_double) :: TPMC3 = 10.0d+00 ! (A)
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
! These global variables are used to speedup calculations
real(c_double), dimension(0:2,0:TPM_MAX_CHAIN-1) :: E1, E2, EE1, EE2
real(c_double), dimension(0:2) :: Q1, Q2, Qe, Qe1, DR, Z1, Z2, S1, S2, Pe, Pe1
real(c_double), dimension(0:TPM_MAX_CHAIN-1) :: W, C
real(c_double), dimension(0:2) :: RR, E10
real(c_double) :: L10, D10
contains !******************************************************************************************
subroutine PairWeight1 ( W, E1_1, E1_2, E2_1, E2_2, R2_1, R2_2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: W
real(c_double), dimension(0:2), intent(out) :: E1_1, E1_2, E2_1, E2_2
real(c_double), dimension(0:2), intent(in) :: R2_1, R2_2
!-------------------------------------------------------------------------------------------
real(c_double) :: D, L20, D20, t, dWdD
real(c_double), dimension(0:2) :: E, E20
!-------------------------------------------------------------------------------------------
E = 0.5d+00 * ( R2_1 + R2_2 ) - RR
call ApplyPeriodicBC ( E )
D = E(0) * E(0) + E(1) * E(1) + E(2) * E(2)
if ( D < D10 * D10 ) then
W = 1.0d+00
E1_1 = 0.0d+00
E1_2 = 0.0d+00
E2_1 = 0.0d+00
E2_2 = 0.0d+00
return
end if
E20 = 0.5d+00 * ( R2_2 - R2_1 )
L20 = sqrt ( S_V3xx ( E20 ) + sqr ( TPMR2 ) )
D20 = L10 + L20 + TPBRcutoff + RSkin
if ( D > D20 * D20 ) then
W = 0.0d+00
E1_1 = 0.0d+00
E1_2 = 0.0d+00
E2_1 = 0.0d+00
E2_2 = 0.0d+00
return
end if
D = sqrt ( D )
E = E / D
E20 = E20 / L20
D20 = D20 - D10
t = ( D - D10 ) / D20
W = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t )
dWdD = 3.0d+00 * t * ( t - 1.0d+00 ) / D20
E1_1 = dWdD * ( t * E10 - E )
E1_2 = dWdD * ( - t * E10 - E )
E2_1 = dWdD * ( E + t * E20 )
E2_2 = dWdD * ( E - t * E20 )
end subroutine PairWeight1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function EndWeight1 ( W, E1_1, E1_2, E2_1, E2_2, R1_1, R1_2, R2_1, R2_2 ) !!!!!!!!
real(c_double), intent(out) :: W
real(c_double), dimension(0:2), intent(out) :: E1_1, E1_2, E2_1, E2_2
real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2
!-------------------------------------------------------------------------------------------
real(c_double) :: D, L20
real(c_double) :: D1, D2, t, dWdD
real(c_double), dimension(0:2) :: RR, E, E20
!-------------------------------------------------------------------------------------------
E = 0.5d+00 * ( R2_1 + R2_2 - ( R1_1 + R1_2 ) )
call ApplyPeriodicBC ( E )
D = S_V3norm3 ( E )
E20 = 0.5d+00 * ( R2_2 - R2_1 )
L20 = sqrt ( S_V3xx ( E20 ) + sqr ( TPMR2 ) )
D1 = L10 + L20 + TPBRcutoff + RSkin
if ( D < D1 ) then
EndWeight1 = 0
W = 1.0d+00
E1_1 = 0.0d+00
E1_2 = 0.0d+00
E2_1 = 0.0d+00
E2_2 = 0.0d+00
return
end if
D2 = D1 + TPMC3
if ( D > D2 ) then
EndWeight1 = 2
W = 0.0d+00
E1_1 = 0.0d+00
E1_2 = 0.0d+00
E2_1 = 0.0d+00
E2_2 = 0.0d+00
return
end if
EndWeight1 = 1
E = E / D
E20 = E20 / L20
t = ( D - D1 ) / TPMC3
W = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t )
dWdD = 3.0d+00 * t * ( t - 1.0d+00 ) / TPMC3
E1_1 = dWdD * ( E10 - E )
E1_2 = dWdD * ( - E10 - E )
E2_1 = dWdD * ( E + E20 )
E2_2 = dWdD * ( E - E20 )
end function EndWeight1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMInteractionFC1 ( Q, U, F1, F2, P1, P2, Pe, Pe1, R1, R2, Q1, Q2, Qe, Qe1, EType )
real(c_double), intent(out) :: Q, U
real(c_double), dimension(0:2), intent(out) :: F1, F2, P1, P2, Pe, Pe1
real(c_double), dimension(0:2), intent(in) :: R1, R2, Q1, Q2, Qe, Qe1
integer(c_int), intent(in) :: EType
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2) :: M, QX, Me, F1a, F2a, P1a, P2a, F1b, F2b, P1b, P2b, ER1, ER2, EQe, EQe1
real(c_double) :: W, W1, D, Qa, Qb, Ua, Ub, L, Pee, Peea, Peeb, DU
integer(c_int) :: IntSigna, IntSignb, CaseID
!-------------------------------------------------------------------------------------------
if ( EType == 0 ) then
! C_TPM_0 = C_TPM_0 + 1
TPMInteractionFC1 = TPMInteractionF ( Q, U, F1, F2, P1, P2, Pee, R1, R2, Q1, Q2, 0 )
Pe = 0.0d+00
Pe1 = 0.0d+00
else if ( EType < 3 ) then
! C_TPM_1 = C_TPM_1 + 1
QX = 0.5d+00 * ( Q1 + Q2 )
M = Q2 - Q1
L = S_V3norm3 ( M )
M = M / L
Me = Qe - QX
D = S_V3norm3 ( Me )
if ( EType == 1 ) then
TPMInteractionFC1 = TPMInteractionF ( Q, U, F1, F2, P1, P2, Pee, R1, R2, QX - D * M, QX, 1 )
else
TPMInteractionFC1 = TPMInteractionF ( Q, U, F1, F2, P1, P2, Pee, R1, R2, QX, QX + D * M, 2 )
end if
call TPMSegmentForces ( P1, P2, F1, F2, R1, R2, QX, M, L )
Pe = ( Pee / D ) * Me
Pe1 = 0.0d+00
QX = 0.5d+00 * Pe
P1 = P1 + QX
P2 = P2 + QX
else
CaseID = EndWeight1 ( W, ER1, ER2, EQe, Eqe1, R1, R2, Qe, Qe1 )
if ( CaseID < 2 ) then
QX = 0.5d+00 * ( Q1 + Q2 )
M = Q2 - Q1
L = S_V3norm3 ( M )
M = M / L
Me = Qe - QX
D = S_V3norm3 ( Me )
if ( EType == 3 ) then
IntSigna = TPMInteractionF ( Qa, Ua, F1a, F2a, P1a, P2a, Peea, R1, R2, QX - D * M, QX, 1 )
else
IntSigna = TPMInteractionF ( Qa, Ua, F1a, F2a, P1a, P2a, Peea, R1, R2, QX, QX + D * M, 2 )
end if
call TPMSegmentForces ( P1a, P2a, F1a, F2a, R1, R2, QX, M, L )
end if
if ( CaseID > 0 ) then
IntSignb = TPMInteractionF ( Qb, Ub, F1b, F2b, P1b, P2b, Peeb, R1, R2, Q1, Q2, 0 )
end if
if ( CaseID == 0 ) then
! C_TPM_1 = C_TPM_1 + 1
TPMInteractionFC1 = IntSigna
Q = Qa
U = Ua
F1 = F1a
F2 = F2a
Pe = ( Peea / D ) * Me
Pe1 = 0.0d+00
QX = 0.5d+00 * Pe
P1 = P1a + QX
P2 = P2a + QX
else if ( CaseID == 2 ) then
! C_TPM_0 = C_TPM_0 + 1
TPMInteractionFC1 = IntSignb
Q = Qb
U = Ub
F1 = F1b
F2 = F2b
P1 = P1b
P2 = P2b
Pe = 0.0d+00
Pe1 = 0.0d+00
else
! C_TPM_2 = C_TPM_2 + 1
TPMInteractionFC1 = 0
if ( IntSigna > 0 .or. IntSignb > 0 ) TPMInteractionFC1 = 1
W1 = 1.0d+00 - W
DU = Ub - Ua
Q = W * Qa + W1 * Qb
U = W * Ua + W1 * Ub
Pe = ( W * Peea / D ) * Me
QX = 0.5d+00 * Pe
F1 = W * F1a + W1 * F1b + DU * ER1
F2 = W * F2a + W1 * F2b + DU * ER2
P1 = W * P1a + W1 * P1b + QX
P2 = W * P2a + W1 * P2b + QX
Pe = Pe - DU * EQe
Pe1 = - DU * EQe1
end if
end if
end function TPMInteractionFC1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMInteractionFW1 ( QQ, U, U1, U2, UU, F1, F2, F, Fe, G1, G2, R1, R2, N, NMAX, R, Re, EType )
real(c_double), intent(out) :: U, U1, U2
integer(c_int), intent(in) :: N, NMAX, EType
real(c_double), dimension(0:NMAX-1), intent(out) :: QQ, UU
real(c_double), dimension(0:2), intent(out) :: F1, F2, Fe
real(c_double), dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2
real(c_double), dimension(0:2), intent(in) :: R1, R2, Re
real(c_double), dimension(0:2,0:NMAX-1), intent(in) :: R
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
real(c_double) :: Q, WW, DD
!-------------------------------------------------------------------------------------------
Q1 = 0.0d+00
Q2 = 0.0d+00
WW = 0.0d+00
Z1 = 0.0d+00
Z2 = 0.0d+00
TPMInteractionFW1 = 0
E10 = 0.5d+00 * ( R2 - R1 )
L10 = sqrt ( S_V3xx ( E10 ) + sqr ( TPMR1 ) )
D10 = TPMR1 + TPMR2 + TPMC123 * TPBRcutoff + RSkin
E10 = E10 / L10
RR = 0.5d+00 * ( R1 + R2 )
do i = 0, N - 2
call PairWeight1 ( W(i), E1(0:2,i), E2(0:2,i), EE1(0:2,i), EE2(0:2,i), R(0:2,i), R(0:2,i+1) )
Q1 = Q1 + W(i) * R(0:2,i)
Q2 = Q2 + W(i) * R(0:2,i+1)
WW = WW + W(i)
Z1 = Z1 + E1(0:2,i)
Z2 = Z2 + E2(0:2,i)
end do
if ( WW .le. TPGeomPrec ) return
Q1 = Q1 / WW
Q2 = Q2 / WW
Z1 = Z1 / WW
Z2 = Z2 / WW
if ( EType == 1 ) then
Qe = R(0:2,0)
Qe1 = R(0:2,1)
else if ( EType == 2 ) then
Qe = R(0:2,N-1)
Qe1 = R(0:2,N-2)
else if ( EType == 3 ) then
Qe = Re
Qe1 = R(0:2,0)
else if ( EType == 4 ) then
Qe = Re
Qe1 = R(0:2,N-1)
else
Qe = 0.0d+00
Qe1 = 0.0d+00
end if
TPMInteractionFW1 = TPMInteractionFC1 ( Q, U, F1, F2, S1, S2, Pe, Pe1, R1, R2, Q1, Q2, Qe, Qe1, EType )
if ( TPMInteractionFW1 == 0 ) return
W(0:N-2) = W(0:N-2) / WW
E1(0:2,0:N-2) = E1(0:2,0:N-2) / WW
E2(0:2,0:N-2) = E2(0:2,0:N-2) / WW
EE1(0:2,0:N-2) = EE1(0:2,0:N-2) / WW
EE2(0:2,0:N-2) = EE2(0:2,0:N-2) / WW
G1(0:2,0:N-1) = 0.0d+00
G2(0:2,0:N-1) = 0.0d+00
U1 = 0.25d+00 * U
U2 = U1
UU = 0.0d+00
do i = 0, N - 2
QQ(i) = W(i) * Q
DD = W(i) * U1
UU(i) = UU(i) + DD
UU(i+1) = UU(i+1) + DD
end do
do i = 0, N - 2
C(i) = S_V3xV3 ( S1, R(0:2,i) ) + S_V3xV3 ( S2, R(0:2,i+1) )
F1 = F1 + C(i) * ( E1(0:2,i) - W(i) * Z1 )
F2 = F2 + C(i) * ( E2(0:2,i) - W(i) * Z2 )
end do
F(0:2,0) = W(0) * S1
do j = 0, N - 2
if ( j == 0 ) then
DR = EE1(0:2,0) * ( 1.0d+00 - W(0) )
else
DR = - W(j) * EE1(0:2,0)
end if
F(0:2,0) = F(0:2,0) + C(j) * DR
end do
do i = 1, N - 2
G1(0:2,i) = W(i-1) * S2
G2(0:2,i) = W(i) * S1
do j = 0, N - 2
if ( j == i ) then
G1(0:2,i) = G1(0:2,i) - C(j) * W(j) * EE2(0:2,i-1)
G2(0:2,i) = G2(0:2,i) + C(j) * ( EE1(0:2,j) - W(j) * EE1(0:2,i) )
else if ( j == i - 1 ) then
G1(0:2,i) = G1(0:2,i) + C(j) * ( EE2(0:2,j) - W(j) * EE2(0:2,i-1) )
G2(0:2,i) = G2(0:2,i) - C(j) * W(j) * EE1(0:2,i)
else
G1(0:2,i) = G1(0:2,i) - C(j) * W(j) * EE2(0:2,i-1)
G2(0:2,i) = G2(0:2,i) - C(j) * W(j) * EE1(0:2,i)
end if
end do
F(0:2,i) = G1(0:2,i) + G2(0:2,i)
end do
F(0:2,N-1) = W(N-2) * S2
do j = 0, N - 2
if ( j == N - 2 ) then
DR = EE2(0:2,N-2) * ( 1.0d+00 - W(N-2) )
else
DR = - W(j) * EE2(0:2,N-2)
end if
F(0:2,N-1) = F(0:2,N-1) + C(j) * DR
end do
Fe = 0.0d+00
if ( EType == 1 ) then
F(0:2,0) = F(0:2,0) - Pe
else if ( EType == 2 ) then
F(0:2,N-1) = F(0:2,N-1) - Pe
else if ( EType == 3 ) then
F(0:2,0) = F(0:2,0) - Pe1
Fe = - Pe
else if ( EType == 4 ) then
F(0:2,N-1) = F(0:2,N-1) - Pe1
Fe = - Pe
end if
G1(0:2,N-1) = F(0:2,N-1)
G2(0:2,0) = F(0:2,0)
end function TPMInteractionFW1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TPMM1 !**********************************************************************************

247
tools/mesont/dump2vtk.cpp Normal file
View File

@ -0,0 +1,247 @@
/* -*- c++ -*- ----------------------------------------------------------
LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
http://lammps.sandia.gov, 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: Maxim Shugaev (UVA), mvs9t@virginia.edu
------------------------------------------------------------------------- */
#include <iostream>
#include <cstdlib>
#include <fstream>
#include <string>
#include <string.h>
#include <vector>
#include <array>
#include <regex>
#include <string.h>
#include <cmath>
//#include <filesystem>
static const std::string data_file0 = "system.init";
static const std::string data_dump0 = "config.dump";
static const std::string out_dir0 = "out";
struct Particle {
double x, y, z, vx, vy, vz, Es, Eb, Et, Ep, Ek;
char type, nx, ny, nz;
};
class Lamps_base {
public:
Lamps_base() = default;
virtual ~Lamps_base() = default;
int open(const std::string& filename);
int next(); //get next snapshot from the opened file
virtual int write(const std::string& filename) const = 0;
inline double get_X1() const { return X1; };
inline double get_X2() const { return X2; };
inline double get_Y1() const { return Y1; };
inline double get_Y2() const { return Y2; };
inline double get_Z1() const { return Z1; };
inline double get_Z2() const { return Z2; };
inline int get_Natoms() const { return Natoms; };
inline int get_Nsteps() const { return Nsteps; };
inline int is_open() const { return open_stat; };
inline const Particle& get(int i) const { return particles[i]; };
inline Particle& get(int i) { return particles[i]; };
protected:
virtual int load() = 0;
int Nsteps, Natoms, open_stat;
double X1, X2, Y1, Y2, Z1, Z2;
std::vector<Particle> particles;
std::ifstream in;
};
class Lamps_dump : public Lamps_base {
public:
Lamps_dump() = default;
~Lamps_dump() = default;
virtual int write(const std::string& filename) const override;
private:
virtual int load() override;
};
int Lamps_base::open(const std::string& filename) {
in.open(filename); if (!in.is_open()) return EXIT_FAILURE;
return load();
}
int Lamps_base::next() {
return load();
}
int Lamps_dump::write(const std::string& filename) const {
return EXIT_FAILURE;
}
int Lamps_dump::load() {
std::string inbuf; char* tmp_cptr;
open_stat = 0;
if (!getline(in, inbuf)) return EXIT_FAILURE;
if (!getline(in, inbuf)) return EXIT_FAILURE;
Nsteps = std::stoi(inbuf);
if (!getline(in, inbuf)) return EXIT_FAILURE;
if (!getline(in, inbuf)) return EXIT_FAILURE;
Natoms = std::stoi(inbuf);
particles.resize(Natoms);
if (!getline(in, inbuf)) return EXIT_FAILURE;
if (!getline(in, inbuf)) return EXIT_FAILURE;
X1 = strtof(inbuf.c_str(), &tmp_cptr);
X2 = strtof(tmp_cptr + 1, &tmp_cptr);
if (!getline(in, inbuf)) return EXIT_FAILURE;
Y1 = strtof(inbuf.c_str(), &tmp_cptr);
Y2 = strtof(tmp_cptr + 1, &tmp_cptr);
if (!getline(in, inbuf)) return EXIT_FAILURE;
Z1 = strtof(inbuf.c_str(), &tmp_cptr);
Z2 = strtof(tmp_cptr + 1, &tmp_cptr);
if (!getline(in, inbuf)) return EXIT_FAILURE;
for (int i = 0; i < Natoms; i++) {
if (!getline(in, inbuf)) return EXIT_FAILURE;
int id = strtol(inbuf.c_str(), &tmp_cptr, 10) - 1; // modify based on a particular file format
particles[id].type = static_cast<char>(strtol(tmp_cptr + 1, &tmp_cptr, 10));
particles[id].x = strtof(tmp_cptr + 1, &tmp_cptr);
particles[id].y = strtof(tmp_cptr + 1, &tmp_cptr);
particles[id].z = strtof(tmp_cptr + 1, &tmp_cptr);
particles[id].Es = strtof(tmp_cptr + 1, &tmp_cptr);
particles[id].Eb = strtof(tmp_cptr + 1, &tmp_cptr);
particles[id].Et = strtof(tmp_cptr + 1, &tmp_cptr);
particles[id].Ep = particles[id].Es + particles[id].Eb + particles[id].Et;
particles[id].Ek = strtof(tmp_cptr + 1, &tmp_cptr);
}
open_stat = true;
return EXIT_SUCCESS;
}
int main(int argc, char* argv[]) {
std::string data_file = (argc > 1) ? argv[1] : data_file0;
std::string data_dump = (argc > 2) ? argv[2] : data_dump0;
std::string out_dir = (argc > 3) ? argv[3] : out_dir0;
//std::filesystem::remove_all(out_dir);
//std::filesystem::create_directories(out_dir);
//list of bonds
std::ifstream in(data_file);
if (!in.is_open()) {
std::cout << "cannot open " << data_file << std::endl;
return EXIT_FAILURE;
}
std::string buf;
std::string atoms_l = "Atoms";
while (std::getline(in, buf)){
if (buf == atoms_l) break;
if (in.eof()) return EXIT_FAILURE;
}
std::getline(in, buf);
char* tmp_cptr;
std::vector<std::array<int, 2>> bonds;
while (std::getline(in, buf)) {
if (in.eof() || buf.size() == 0) break;
int idx = strtol(buf.c_str(), &tmp_cptr, 10);
int m_idx = strtol(tmp_cptr + 1, &tmp_cptr, 10);
int type = strtol(tmp_cptr + 1, &tmp_cptr, 10);
int id1 = strtol(tmp_cptr + 1, &tmp_cptr, 10);
int id2 = strtol(tmp_cptr + 1, &tmp_cptr, 10);
if(id1 >= 0 && id2 >= 0) bonds.push_back({id1 - 1, id2 - 1});
}
//dump
Lamps_dump dump;
dump.open(data_dump);
if (!dump.is_open()) {
std::cout << "cannot open " << data_dump << std::endl;
return EXIT_FAILURE;
}
double Lx = dump.get_X2() - dump.get_X1();
double Ly = dump.get_Y2() - dump.get_Y1();
double Lz = dump.get_Z2() - dump.get_Z1();
while (1) {
std::ofstream out(out_dir + "/cnt" + std::to_string(dump.get_Nsteps()) + ".vtk");
if (!out.is_open()) {
std::cout << "cannot create " << out_dir + "/cnt" + std::to_string(dump.get_Nsteps()) + ".vtk" << std::endl;
std::cout << "create the output directory \"" << out_dir << "\" manually" << std::endl;
return EXIT_FAILURE;
}
out << "# vtk DataFile Version 3.0\n# \nASCII\n\nDATASET UNSTRUCTURED_GRID\n";
out << "POINTS " << dump.get_Natoms() << " float\n";
for (int i = 0; i < dump.get_Natoms(); i++) {
out << dump.get(i).x << " " << dump.get(i).y << " " << dump.get(i).z << " " << "\n";
}
int bond_count = 0;
for (int i = 0; i < bonds.size(); i++) {
double f1 = std::fabs(dump.get(bonds[i][0]).x - dump.get(bonds[i][1]).x);
double f2 = std::fabs(dump.get(bonds[i][0]).y - dump.get(bonds[i][1]).y);
double f3 = std::fabs(dump.get(bonds[i][0]).z - dump.get(bonds[i][1]).z);
if ((std::fabs(dump.get(bonds[i][0]).x - dump.get(bonds[i][1]).x) < 0.5*Lx)
&& (std::fabs(dump.get(bonds[i][0]).y - dump.get(bonds[i][1]).y) < 0.5*Ly)
&& (std::fabs(dump.get(bonds[i][0]).z - dump.get(bonds[i][1]).z) < 0.5*Lz))
bond_count++;
}
out << "\nCELLS " << bond_count << " " << 3*bond_count << "\n";
for (int i = 0; i < bonds.size(); i++) {
if ((std::fabs(dump.get(bonds[i][0]).x - dump.get(bonds[i][1]).x) < 0.5 * Lx)
&& (std::fabs(dump.get(bonds[i][0]).y - dump.get(bonds[i][1]).y) < 0.5 * Ly)
&& (std::fabs(dump.get(bonds[i][0]).z - dump.get(bonds[i][1]).z) < 0.5 * Lz))
out << "2 " << bonds[i][0] << " " << bonds[i][1] << " " << "\n";
}
out << "\nCELL_TYPES " << bond_count << "\n";
for (int i = 0; i < bond_count; i++) {
out << "4\n";
}
out << "\nPOINT_DATA " << dump.get_Natoms() << "\n";
out << "SCALARS Ep float 1\n";
out << "LOOKUP_TABLE default\n";
for (int i = 0; i < dump.get_Natoms(); i++) {
out << dump.get(i).Ep << "\n";
}
out << "\nSCALARS Ek float 1\n";
out << "LOOKUP_TABLE default\n";
for (int i = 0; i < dump.get_Natoms(); i++) {
out << dump.get(i).Ek << "\n";
}
out << "\nSCALARS Es float 1\n";
out << "LOOKUP_TABLE default\n";
for (int i = 0; i < dump.get_Natoms(); i++) {
out << dump.get(i).Es << "\n";
}
out << "\nSCALARS Eb float 1\n";
out << "LOOKUP_TABLE default\n";
for (int i = 0; i < dump.get_Natoms(); i++) {
out << dump.get(i).Eb << "\n";
}
out << "\nSCALARS Et float 1\n";
out << "LOOKUP_TABLE default\n";
for (int i = 0; i < dump.get_Natoms(); i++) {
out << dump.get(i).Et << "\n";
}
if (dump.next() != EXIT_SUCCESS) break;
}
return EXIT_SUCCESS;
}