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

270
lib/mesont/CNTPot.f90
View File

@ -15,13 +15,13 @@
module CNTPot !*************************************************************************************
!
! TMD Library: Mesoscopic potential for internal modes in CNTs
! Mesoscopic potential for internal modes in CNTs.
!
!---------------------------------------------------------------------------------------------------
!
! Implementation of carbon nanotubes internal potentials:
! 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
! CNTSTRH1, harmonic stretching potential of type 1 with variable Young's 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
@ -30,33 +30,32 @@ module CNTPot !*****************************************************************
! CNTTRS, torsion potential
! CNTBRT, breathing potential
!
! The functional form and force constants of harmonic streatching, bending and
! The functional form and force constants of harmonic stretching, 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),
! The model of stress-strain curve for the non-harmonic potential with fracture
! is developed and parameterized using the following constants
! -- Young's modulus
! -- maximum linear strain (only for the NH potential of type 1)
! -- tensile strength (or fracture strain)
! -- 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.
! -- maximum strain.
! All these parameters are assumed to be independent of CNT radius or chriality type.
! In this model, the true strain at failure CNTSTREft and true tensile strength
! CNTSTRSft are slightly different from the imposed values CNTSTREf and CNTSTRSf.
!
! 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
! 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
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!***************************************************************************************************
@ -75,20 +74,27 @@ implicit none
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
! Harmonic stretching model (constant Young's modulus)
integer(c_int), parameter :: CNTSTRMODEL_H0 = 0
! Harmonic stretching model (Young's modulus depends on radius)
integer(c_int), parameter :: CNTSTRMODEL_H1 = 1
! Non-harmonic stretching with fracture, potential of type 0
integer(c_int), parameter :: CNTSTRMODEL_NH0F = 2
! Non-harmonic stretching without fracture, potential of type 1
integer(c_int), parameter :: CNTSTRMODEL_NH1 = 3
! Non-harmonic stretching with fracture, potential of type 1
integer(c_int), parameter :: CNTSTRMODEL_NH1F = 4
! Harmonic stretching model + axial buckling
integer(c_int), parameter :: CNTSTRMODEL_H1B = 5
! Harmonic stretching model + axial buckling + hysteresis
integer(c_int), parameter :: CNTSTRMODEL_H1BH = 6
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
integer(c_int), parameter :: CNTPOTNMAX = 4000 ! Maximum number of points in the interpolation tables
!---------------------------------------------------------------------------------------------------
! Parameters of potentials
@ -96,53 +102,51 @@ implicit none
! 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
! Type of the bending model
integer(c_int) :: CNTSTRModel = CNTSTRMODEL_H1
! Type of parameterization
integer(c_int) :: CNTSTRParams = 0
! Type of dependence of the Young's modulus on tube radius
integer(c_int) :: CNTSTRYMT = 0
! 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) :: CNTSTRR0 = 6.8d+00 ! Reference radius of nanotubes (A)
! (this parameter is not used for the model
! parametrization, but only for calculation of the
! force constant in eV/A)
real(c_double) :: CNTSTRD0 = 3.4d+00 ! CNT wall thickness (A)
real(c_double) :: CNTSTREmin = -0.4d+00 ! Minimum strain in tabulated potential
real(c_double) :: CNTSTREmax = 0.13d+00 ! Maximum strain in tabulated potential.
! Simultaneously, U=0 if E> CNTSTREmax
real(c_double) :: CNTSTREl = 5.0d-02 ! Maximum 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) :: CNTSTRS0 = 0.850e+12 ! Young's modulus (Pa)
real(c_double) :: CNTSTRSl ! Maximum linear stress (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 ! Maximum stress (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 ! /
real(c_double) :: CNTSTRAAA, CNTSTRBBB ! Auxiliary 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
! Axial buckling - hysteresis approach
real(c_double) :: CNTSTREc = -0.0142d+00 ! The minimum buckling strain
real(c_double) :: CNTSTREc1 = -0.04d+00 ! Critical axial buckling strain
real(c_double) :: CNTSTREc2 = -0.45d+00 ! Maximum buckling strain
! 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
integer(c_int) :: CNTBNDModel = CNTBNDMODEL_H ! Type of the bending model
! 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) :: CNTBNDR = 275.0d+00 ! Critical radius of curvature (A)
! This is the 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
@ -153,7 +157,7 @@ contains !**********************************************************************
!---------------------------------------------------------------------------------------------------
subroutine CNTSTRSetParameterization ( PType ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Setup parameters for further parameterization of streatching models
! This subroutine setups parameters for further parameterization of stretching 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)
@ -161,7 +165,7 @@ contains !**********************************************************************
! [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
integer(c_int), intent(in) :: PType
!-------------------------------------------------------------------------------------------
select case ( PType )
case ( 0 ) ! This parametrization is based on averaged exp. data of Ref. [1]
@ -173,35 +177,36 @@ contains !**********************************************************************
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
case ( 1 ) ! This parameterization is taken from Ref. [2] for (10,10) CNTs.
! These values are obtained in MD simulations with REBO potential.
! Values of Young's modulus, tensile strength 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
! (5,5) CNT in semi-empirical QM calculations based on PM3 model
CNTSTRR0 = 6.785d+00 ! Calculated with the 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]
CNTSTREf = 27.9d-02 ! Corresponds to maximum 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
CNTSTRSf = 148.5d+09 ! Corresponds to tensile strength in Ref. [2]
case ( 2 ) ! This parametrization is taken from Ref. [3] for (5,5) CNTs
! with one atom vacancy defect obtained with the semi-empirical 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]
CNTSTREl = 6.00d-02 ! Chosen 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
case ( 3 ) ! This special parameterization changes only the value of Young's modulus
! in accordance with the stretching constant in Ref. [4]
CNTSTRS0 = ( 86.64d+00 + 100.56d+00 * CNTSTRR0 ) * K_MDFU &
/ ( M_2PI * CNTSTRR0 * CNTSTRD0 * 1.0d-20 ) ! Ref. [4]
case ( 4 ) ! This special parameterization changes only the 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
CNTSTRR0 = 6.785d+00 ! Calculated with the usual formula for (10,10) CNT
CNTSTRD0 = 3.4d+00 ! Ref. [1]
CNTSTRS0 = 1.06e+12 ! Ref. [5]
end select
@ -211,8 +216,8 @@ contains !**********************************************************************
! Stretching without fracture, harmonic potential
!
integer(c_int) function CNTSTRH0Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus is independent of R
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
@ -224,8 +229,8 @@ contains !**********************************************************************
CNTSTRH0Calc = CNTPOT_STRETCHING
end function CNTSTRH0Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTSTRH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus depends on R, see [4]
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
@ -242,9 +247,9 @@ contains !**********************************************************************
! 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
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
@ -253,16 +258,16 @@ contains !**********************************************************************
E = ( L - L0 ) / L0
K = 86.64d+00 + 100.56d+00 * R0
Kbcl = -10.98d+00 * L0
if ( E .gt. CNTSTREc ) then !Harmonic stretching
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
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
CNTSTRH1BCalc = CNTPOT_STRETCHING
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
@ -276,7 +281,7 @@ contains !**********************************************************************
! Stretching without fracture, harmonic potential, with axial buckling with hysteresis
!
integer(c_int) function CNTSTRH1BHCalc ( U, dUdL, L, R0, L0, ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!
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
@ -289,18 +294,18 @@ contains !**********************************************************************
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
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
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
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
@ -308,13 +313,13 @@ contains !**********************************************************************
Ebuc = 0.0d+00
end if
else if( E .gt. CNTSTREc2 ) then ! Axial buckling strain region
if ( ABF .eq. 0 ) then !newly buckled
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
else ! Already buckled
dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc
U = Kbcl * E + dUbcl
dUdL = Kbcl / L0
@ -333,7 +338,7 @@ contains !**********************************************************************
! Stretching with fracture, non-harmonic potential of type 0
!
integer(c_int) function CNTSTRNH0FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
@ -375,7 +380,7 @@ contains !**********************************************************************
! Stretching without fracture, non-harmonic potential of type 1
!
integer(c_int) function CNTSTRNH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
@ -400,11 +405,10 @@ contains !**********************************************************************
! Stretching with fracture, non-harmonic potential of type 1
!
integer(c_int) function CNTSTRNH1FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
@ -418,8 +422,6 @@ contains !**********************************************************************
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
@ -452,8 +454,7 @@ contains !**********************************************************************
! General
!
!integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 , ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!!
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
@ -480,8 +481,6 @@ contains !**********************************************************************
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
@ -500,15 +499,6 @@ contains !**********************************************************************
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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
@ -516,8 +506,6 @@ contains !**********************************************************************
!---------------------------------------------------------------------------------------------------
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
@ -538,9 +526,8 @@ contains !**********************************************************************
G1 = - ( G0 + G2 )
end subroutine BendingGradients !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTBNDHCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Bending model of type 0:
! Harmonic bending potential
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
@ -553,9 +540,8 @@ contains !**********************************************************************
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
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
@ -570,7 +556,8 @@ contains !**********************************************************************
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
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
@ -582,7 +569,7 @@ contains !**********************************************************************
end if
end function CNTBNDHBCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTBNDHBFCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
@ -601,7 +588,8 @@ contains !**********************************************************************
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
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
@ -614,9 +602,8 @@ contains !**********************************************************************
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.
integer(c_int) function CNTBNDHBHCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!
! Bending model of type 1: Harmonic bending potential with buckling with hysteresis approach.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: U, dUdC, Ebuc
real(c_double), intent(in) :: C , R0, L0
@ -636,7 +623,7 @@ contains !**********************************************************************
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
else if ( C2 .ge. Cmin .and. C2 .lt. CNTBNDC2 ) then ! Potential depends on buckling flag of a 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
@ -647,7 +634,8 @@ contains !**********************************************************************
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
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
@ -658,7 +646,8 @@ contains !**********************************************************************
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
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
@ -667,10 +656,12 @@ contains !**********************************************************************
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
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
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
@ -680,8 +671,7 @@ contains !**********************************************************************
! General
!
! integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
@ -707,16 +697,6 @@ contains !**********************************************************************
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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------

129
lib/mesont/ExportCNT.f90
View File

@ -13,18 +13,20 @@
! Contributing author: Maxim Shugaev (UVA), mvs9t@virginia.edu
!-------------------------------------------------------------------------
module ExportCNT !*******************************************************************************
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
integer(c_int), intent(in) :: STRModel, STRParams, YMType, BNDModel
real(c_double), intent(in) :: Rref
call InitCNTPotModule(STRModel, STRParams, YMType, BNDModel, Rref)
@ -38,30 +40,22 @@ contains
subroutine TPMInit_(M, N) &
bind(c, name = "mesont_lib_TPMInit")
integer(c_int), intent(in) :: M, N
integer(c_int), intent(in) :: M, N
call TPMInit(M, N)
endsubroutine
subroutine SetTablePath_(TPMSSTPFile_, N1, TPMAFile_, N2) &
subroutine SetTablePath_(TPMFile_, N) &
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(c_int), intent(in) :: N
character(c_char), intent(in), dimension(N) :: TPMFile_
integer :: i
do i = 1, len(TPMSSTPFile)
if (i <= N1) then
TPMSSTPFile(i:i) = TPMSSTPFile_(i)
do i = 1, len(TPMFile)
if (i <= N) then
TPMFile(i:i) = TPMFile_(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) = ' '
TPMFile(i:i) = ' '
endif
enddo
endsubroutine
@ -76,50 +70,81 @@ contains
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 segment nodes
real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: L12 ! Equilibrium length of segment (X1,X2)
! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout) :: U1, U2
! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2) :: F1, F2
! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2
! Coordinates of the segment nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2
! Radius of a nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R12
! Equilibrium length of segment (X1,X2)
real(c_double), intent(in) :: L12
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 ! Equilibrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments)
integer(c_int), intent(inout) :: BBF2
! Interaction energies associated with nodes X1, X2, and X3
real(c_double), intent(inout) :: U1, U2, U3
! Forces exerted on nodes X1, X2, and X3
real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3
! Contributions of nodes X1, X2, and X3 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3
! Coordinates of nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2, X3
! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R123
! Equilibrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments)
real(c_double), intent(in) :: L123
integer(c_int), intent(inout) :: BBF2
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) &
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 segment 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 chain node 0 is a CNT end; E2 = 1 if the chain 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)
! Number of nodes in array X
integer(c_int), intent(in) :: N
! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout) :: U1, U2
! Interaction energies associated with nodes X
real(c_double), intent(inout), dimension(0:N-1) :: U
! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2) :: F1, F2
! Forces exerted on nodes X
real(c_double), intent(inout), dimension(0:2,0:N-1) :: F
! Force exerted on node Xe (can be updated only if Ee > 0)
real(c_double), intent(inout), dimension(0:2) :: Fe
! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2
! Contributions of nodes X to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S
! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0)
real(c_double), intent(inout), dimension(0:2,0:2) :: Se
! Coordinates of the segment nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2
! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R12
! Coordinates of the nanotube nodes
real(c_double), intent(in), dimension(0:2,0:N-1) :: X
! Additional node of the extended chain if Ee > 0
real(c_double), intent(in), dimension(0:2) :: Xe
! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i)
integer(c_int), intent(in), dimension(0:N-1) :: BBF
! Radius of nanotube X
real(c_double), intent(in) :: R
! E1 = 1 if the chain node 0 is a CNT end; E2 = 1 if the chain node N-1 is a CNT end;
integer(c_int), intent(in) :: E1, E2
! Parameter defining the type of the extended chain (0,1,2)
integer(c_int), intent(in) :: Ee
! Type of the tubular potential (0 or 1)
integer(c_int), intent(in) :: TPMType
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 !**************************************************************************
endmodule ExportCNT !*******************************************************************************

98
lib/mesont/Install.py
View File

@ -1 +1,97 @@
../Install.py
#!/usr/bin/env python
"""
Install.py tool to do a generic build of a library
soft linked to by many of the lib/Install.py files
used to automate the steps described in the corresponding lib/README
"""
from __future__ import print_function
import sys, os, subprocess
from argparse import ArgumentParser
sys.path.append('..')
from install_helpers import get_cpus, fullpath
parser = ArgumentParser(prog='Install.py',
description="LAMMPS library build wrapper script")
HELP = """
Syntax from src dir: make lib-libname args="-m machine -e suffix"
Syntax from lib dir: python Install.py -m machine -e suffix
libname = name of lib dir (e.g. atc, h5md, meam, poems, etc)
specify -m and optionally -e, order does not matter
Examples:
make lib-poems args="-m serial" # build POEMS lib with same settings as in the serial Makefile in src
make lib-colvars args="-m mpi" # build USER-COLVARS lib with same settings as in the mpi Makefile in src
make lib-meam args="-m ifort" # build MEAM lib with custom Makefile.ifort (using Intel Fortran)
"""
# parse and process arguments
parser.add_argument("-m", "--machine",
help="suffix of a <libname>/Makefile.* file used for compiling this library")
parser.add_argument("-e", "--extramake",
help="set EXTRAMAKE variable in <libname>/Makefile.<machine> to Makefile.lammps.<extramake>")
args = parser.parse_args()
# print help message and exit, if neither build nor path options are given
if not args.machine and not args.extramake:
parser.print_help()
sys.exit(HELP)
machine = args.machine
extraflag = args.extramake
if extraflag:
suffix = args.extramake
else:
suffix = 'empty'
# set lib from working dir
cwd = fullpath('.')
lib = os.path.basename(cwd)
# create Makefile.auto as copy of Makefile.machine
# reset EXTRAMAKE if requested
if not os.path.exists("Makefile.%s" % machine):
sys.exit("lib/%s/Makefile.%s does not exist" % (lib, machine))
lines = open("Makefile.%s" % machine, 'r').readlines()
fp = open("Makefile.auto", 'w')
has_extramake = False
for line in lines:
words = line.split()
if len(words) == 3 and words[0] == "EXTRAMAKE" and words[1] == '=':
has_extramake = True
if extraflag:
line = line.replace(words[2], "Makefile.lammps.%s" % suffix)
fp.write(line)
fp.close()
# make the library via Makefile.auto optionally with parallel make
n_cpus = get_cpus()
print("Building lib%s.a ..." % lib)
cmd = "make -f Makefile.auto clean; make -f Makefile.auto -j%d" % n_cpus
try:
txt = subprocess.check_output(cmd, shell=True, stderr=subprocess.STDOUT)
print(txt.decode('UTF-8'))
except subprocess.CalledProcessError as e:
print("Make failed with:\n %s" % e.output.decode('UTF-8'))
sys.exit(1)
if os.path.exists("lib%s.a" % lib):
print("Build was successful")
else:
sys.exit("Build of lib/%s/lib%s.a was NOT successful" % (lib, lib))
if has_extramake and not os.path.exists("Makefile.lammps"):
print("WARNING: lib/%s/Makefile.lammps was NOT created" % lib)

4
lib/mesont/LinFun2.f90
View File

@ -15,7 +15,7 @@
module LinFun2 !************************************************************************************
!
! TMD Library: Bi-linear functions and their derivatives
! Bi-linear functions and their derivatives.
!
!---------------------------------------------------------------------------------------------------
!
@ -29,7 +29,7 @@ implicit none
contains !******************************************************************************************
real(c_double) function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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

3
lib/mesont/Makefile.gfortran
View File

@ -21,7 +21,6 @@ OBJ = $(SRC:.f90=.o)
F90 = gfortran
CC = gcc
F90FLAGS = -O3 -fPIC -ffast-math -ftree-vectorize -fexpensive-optimizations -fno-second-underscore -g -ffree-line-length-none
#F90FLAGS = -O
ARCHIVE = ar
ARCHFLAG = -rc
LINK = g++
@ -46,7 +45,7 @@ lib: $(OBJ)
%.o:%.c
$(CC) $(F90FLAGS) -c $<
#include .depend
include .depend
# ------ CLEAN ------
clean:

2
lib/mesont/Makefile.ifort
View File

@ -42,7 +42,7 @@ lib: $(OBJ)
%.o:%.c
$(CC) $(F90FLAGS) -c $<
#include .depend
include .depend
# ------ CLEAN ------
clean:

56
lib/mesont/Makefile.serial
View File

@ -1 +1,55 @@
Makefile.gfortran
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
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)

25
lib/mesont/Spline1.f90
View File

@ -15,7 +15,7 @@
module Spline1 !************************************************************************************
!
! TMD Library: One-dimensional cubic spline function
! One-dimensional cubic spline function.
!
!---------------------------------------------------------------------------------------------------
!
@ -29,14 +29,15 @@ implicit none
contains !******************************************************************************************
real(c_double) function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!!!
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
!-------------------------------------------------------------------------------------------
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 ) !!!!!!!!!!!!!!!!!
@ -55,9 +56,6 @@ 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
@ -124,7 +122,7 @@ contains !**********************************************************************
call sprogonka3 ( N, K0, K1, K2, D, M )
end subroutine CreateSpline1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
@ -141,7 +139,8 @@ 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 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -162,8 +161,8 @@ contains !**********************************************************************
HR2 = HR * HR
HLH = HL / H
HRH = HR / H
S = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH
S1 = ( ( M(i) * HL2 - M(j) * HR2 ) / 2.0d+00 + F(i) - F(j) ) / H - H6 * ( M(i) - M(j) )
S = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH
S1 = ( ( M(i) * HL2 - M(j) * HR2 ) / 2.0d+00 + F(i) - F(j) ) / H - H6 * ( M(i) - M(j) )
end subroutine CalcSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_2 ( S, S1, S2, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -184,9 +183,9 @@ contains !**********************************************************************
HR2 = HR * HR
HLH = HL / H
HRH = HR / H
S = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH
S1 = ( ( M(i) * HL2 - M(j) * HR2 ) / 2.0d+00 + F(i) - F(j) ) / H - H6 * ( M(i) - M(j) )
S2 = M(j) * HRH + M(i) * HLH
S = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH
S1 = ( ( M(i) * HL2 - M(j) * HR2 ) / 2.0d+00 + F(i) - F(j) ) / H - H6 * ( M(i) - M(j) )
S2 = M(j) * HRH + M(i) * HLH
end subroutine CalcSpline1_2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module Spline1 !********************************************************************************

20
lib/mesont/Spline2.f90
View File

@ -15,7 +15,7 @@
module Spline2 !************************************************************************************
!
! TMD Library: Two-dimensional cubic spline function
! Two-dimensional cubic spline function.
!
!---------------------------------------------------------------------------------------------------
!
@ -32,12 +32,12 @@ 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
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(c_int) :: II
!-------------------------------------------------------------------------------------------
do II = 0, N2 - 1
FF(0:N1-1) = F(0:N1-1,II)
@ -69,12 +69,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
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(c_int) :: II
!-------------------------------------------------------------------------------------------
Fxx = 0.0d+00
Fyy = 0.0d+00
@ -142,13 +142,13 @@ 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) 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
integer(c_int) :: i1, j1
real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
!-------------------------------------------------------------------------------------------
i1 = i - 1
@ -163,12 +163,12 @@ contains !**********************************************************************
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
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
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
!-------------------------------------------------------------------------------------------

162
lib/mesont/TPMForceField.f90
View File

@ -13,15 +13,15 @@
! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu
!-------------------------------------------------------------------------
module TPMForceField !************************************************************************************
module TPMForceField !******************************************************************************
!
! TMD Library: Calculation of the TMD force field
! Calculation of the TMD force field
!
!---------------------------------------------------------------------------------------------------
!
! PGI Fortran, Intel Fortran
!
! Alexey N. Volkov, University of Alabama (avolkov1@ua.edu), Version 09.01.33, 2018
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, version 09.01, 2020
!
!***************************************************************************************************
@ -34,12 +34,18 @@ 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)
! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout) :: U1, U2
! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2) :: F1, F2
! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2
! Coordinates of the segment nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2
! Radius of a nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R12
! Equilibrium length of segment (X1,X2)
real(c_double), intent(in) :: L12
!-------------------------------------------------------------------------------------------
integer(c_int) :: ii, jj, Event
real(c_double) :: U, F, LL, S, Ubcl
@ -69,15 +75,21 @@ contains !**********************************************************************
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
! Interaction energies associated with nodes X1, X2, and X3
real(c_double), intent(inout) :: U1, U2, U3
! Forces exerted on nodes X1, X2, and X3
real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3
! Contributions of nodes X1, X2, and X3 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3
! Coordinates of nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2, X3
! Radius of nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R123
! Equilibrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments)
real(c_double), intent(in) :: L123
integer(c_int), intent(inout) :: BBF2
!-------------------------------------------------------------------------------------------
integer(c_int) :: ii, jj, Event
integer(c_int) :: ii, jj, Event
real(c_double) :: U, F, K, S, Ubcl
real(c_double), dimension(0:2) :: G0, G1, G2
!-------------------------------------------------------------------------------------------
@ -115,67 +127,81 @@ contains !**********************************************************************
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
! (as well potential energies and components of the virial stress tensor) between a segment
! (X1,X2) and a sequence of segments which belongs to a single CNT.
! It is assumed that X contains ALL nodes of a single CNT that are included into the
! neighbor list of segment (X1,X2)
! 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
! The nodes in X are assumed to be ordered according to their physical appearance in the nanotube.
! It means that (X(i),X(i+1)) are either correspond to a real segment or divided by segments
! that do not belong to a nanotube.
! Concept of the 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.
! Concept of the extended chain:
! Let's consider a sequence of nodes (X1,X2,...,XN) forming continuous part of a nanotube.
! If node Xe precedes X1 and Xe is the nanotube end, then the extended chain is (Xe,X1,...,XN) and Ee = 1.
! If node Xe follows XN and Xe is the nanotube end, then the extended chain is (X1,...,XN,Xe) and Ee = 2.
! In all other cases, 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
! In all other cases, the extended chain coincides with (X1,...,XN) and Ee = 0.
! If the extended chain contains additional node, then non-zero force is exerted on this node.
subroutine SegmentTubeForceField ( U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType )
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)
subroutine SegmentTubeForceField ( U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe,&
BBF, R, E1, E2, Ee, TPMType )
! Number of nodes in array X
integer(c_int), intent(in) :: N
! Interaction energies associated with nodes X1 and X2
real(c_double), intent(inout) :: U1, U2
! Interaction energies associated with nodes X
real(c_double), intent(inout), dimension(0:N-1) :: U
! Forces exerted on nodes X1 and X2
real(c_double), intent(inout), dimension(0:2) :: F1, F2
! Forces exerted on nodes X
real(c_double), intent(inout), dimension(0:2,0:N-1) :: F
! Force exerted on node Xe (can be updated only if Ee > 0)
real(c_double), intent(inout), dimension(0:2) :: Fe
! Contributions of nodes X1 and X2 to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2
! Contributions of nodes X to the virial stress tensor
real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S
! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0)
real(c_double), intent(inout), dimension(0:2,0:2) :: Se
! Coordinates of the segment nodes
real(c_double), intent(in), dimension(0:2) :: X1, X2
! Radius of a nanotube the segment (X1,X2) belongs to
real(c_double), intent(in) :: R12
! Coordinates of the nanotube nodes
real(c_double), intent(in), dimension(0:2,0:N-1) :: X
! Additional node of the extended chain if Ee > 0
real(c_double), intent(in), dimension(0:2) :: Xe
! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i)
integer(c_int), intent(in), dimension(0:N-1) :: BBF
! Radius of nanotube X
real(c_double), intent(in) :: R
! E1 = 1 if the chain node 0 is a CNT end; E1 = 2 if the chain node N-1 is a CNT end
integer(c_int), intent(in) :: E1, E2
! Parameter defining the type of the extended chain (0,1,2)
integer(c_int), intent(in) :: Ee
! Type of the tubular potential (0 or 1)
integer(c_int), intent(in) :: TPMType
!-------------------------------------------------------------------------------------------
integer(c_int) :: k, ii, jj, IntSign
integer(c_int) :: BType, EType, LocalTPMType
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
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)
! Interaction energies associated with nodes X1 and X2
real(c_double) :: xU1, xU2
! Interaction energies associated with nodes X
real(c_double), dimension(0:N-1) :: xU
! Forces exerted on nodes X1 and X2
real(c_double), dimension(0:2) :: xF1, xF2
! Forces exerted on nodes X
real(c_double), dimension(0:2,0:N-1) :: xF
! Force exerted on node Xe (can be updated only if Ee > 0)
real(c_double), dimension(0:2) :: xFe
!-------------------------------------------------------------------------------------------
!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
@ -192,12 +218,12 @@ contains !**********************************************************************
LocalTPMType = 0
EType = 0
else
if ( E1 == 1 ) then ! First node in the chain is the tube end
if ( E1 == 1 ) then ! The first node in the chain is the tube end
EType1 = .true.
else
EType1 = .false.
end if
if ( E2 == 1 ) then ! Last node in the chain is the tube end
if ( E2 == 1 ) then ! The last node in the chain is the tube end
EType2 = .true.
else
EType2 = .false.
@ -220,9 +246,9 @@ contains !**********************************************************************
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
if ( Ee == 1 ) then ! The 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
else if ( Ee == 2 ) then ! The last node in the extended chain is the tube end
EType = 4
end if
end if

44
lib/mesont/TPMGeom.f90
View File

@ -15,7 +15,7 @@
module TPMGeom !************************************************************************************
!
! TMD Library: Geometry functions
! Geometry functions.
!
!---------------------------------------------------------------------------------------------------
!
@ -46,25 +46,21 @@ implicit none
real(c_double) :: DomLXhalf, DomLYhalf, DomLZhalf
! Boundary conditions
integer(c_int) :: BC_X = 0
integer(c_int) :: BC_Y = 0
integer(c_int) :: BC_Z = 0
integer(c_int) :: BC_X = 0
integer(c_int) :: BC_Y = 0
integer(c_int) :: BC_Z = 0
! Skin parameter in NBL and related algorithms
real(c_double) :: Rskin = 1.0d+00
real(c_double) :: Rskin = 1.0d+00
contains !******************************************************************************************
subroutine ApplyPeriodicBC ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This subroutine changes coortinates of the point accorning to periodic boundary conditions
! it order to makesure that the point is inside the computational cell
! This subroutine changes coordinates of the point according to the periodic boundary conditions
! it order to make sure that the point is inside the computational cell,
!-------------------------------------------------------------------------------------------
real(c_double), 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 )
!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
@ -89,8 +85,8 @@ contains !**********************************************************************
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
! This function calculates the point Q of projection of point R0 onto line (R1,L1).
! Q = R1 + Displacement * L1.
!-------------------------------------------------------------------------------------------
real(c_double), intent(inout) :: Displacement
real(c_double), dimension(0:2), intent(inout) :: Q
@ -103,18 +99,18 @@ contains !**********************************************************************
Q = R1 + Displacement * L1
end subroutine LinePoint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) 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)
integer(c_int) function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!!
! This function determines the smallest 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)
! 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, displacemets
! L12, unit vector directed along the closes distance
! H, minimum distance between lines.
! cosA, cosine of the angle between lines.
! D1, D2, displacements.
! L12, unit vector directed along the closest distance.
!-------------------------------------------------------------------------------------------
real(c_double), intent(inout) :: H, cosA, D1, D2
real(c_double), dimension(0:2), intent(out) :: L12
@ -132,7 +128,7 @@ contains !**********************************************************************
end if
LineLine = MD_LINES_NONPAR
R = R2 - R1
! Here we take into account periodic boundaries
! Here we take into account periodic boundary conditions
call ApplyPeriodicBC ( R )
DD1 = S_V3xV3 ( R, L1 )
DD2 = S_V3xV3 ( R, L2 )
@ -141,7 +137,7 @@ contains !**********************************************************************
Q1 = R1 - D1 * L1
Q2 = R2 - D2 * L2
L12 = Q2 - Q1
! Here we take into account periodic boundaries
! Here we take into account periodic boundary conditions
call ApplyPeriodicBC ( L12 )
H = S_V3norm3 ( L12 )
if ( H < Prec ) then ! Lines intersect each other

38
lib/mesont/TPMLib.f90
View File

@ -15,7 +15,7 @@
module TPMLib !*************************************************************************************
!
! TMD Library: Basic constants, types, and mathematical functions
! Basic constants, types, and mathematical functions.
!
!---------------------------------------------------------------------------------------------------
!
@ -41,20 +41,20 @@ implicit none
! 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(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(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(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))
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
integer(c_int) :: StdUID = 31
integer(c_int) :: StdUID = 31
contains !******************************************************************************************
@ -62,19 +62,19 @@ contains !**********************************************************************
! Simple mathematical functions
!---------------------------------------------------------------------------------------------------
real(c_double) function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: X
!-------------------------------------------------------------------------------------------
rad = X * M_PI_180
end function rad !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: X
!-------------------------------------------------------------------------------------------
sqr = X * X
end function sqr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: X
!-------------------------------------------------------------------------------------------
if ( X > 0 ) then
@ -90,27 +90,25 @@ contains !**********************************************************************
! Vector & matrix functions
!---------------------------------------------------------------------------------------------------
real(c_double) function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), 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) function S_V3xV3 ( V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), 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) function S_V3norm3 ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), 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(c_double), dimension(0:2), intent(inout) :: V
!-------------------------------------------------------------------------------------------
real(c_double) :: Vabs
@ -122,8 +120,6 @@ contains !**********************************************************************
end subroutine V3_ort !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
!-------------------------------------------------------------------------------------------
@ -175,10 +171,10 @@ contains !**********************************************************************
end subroutine EulerAngles !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! File inout and output
! File input and output
!---------------------------------------------------------------------------------------------------
integer(c_int) function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
character*(*), intent(in) :: Name, Params, Path
!-------------------------------------------------------------------------------------------
integer(c_int) :: Fuid

19
lib/mesont/TPMM0.f90
View File

@ -15,9 +15,9 @@
module TPMM0 !**************************************************************************************
!
! TMD Library: Combined/Weighted potential of type 0
! Combined/Weighted TPM potential of type 0.
!
! Direct application of SST potential to calculation of segment-segment interaction
! Direct application of SST potential to calculation of segment-segment interaction.
!
!---------------------------------------------------------------------------------------------------
!
@ -27,7 +27,6 @@ module TPMM0 !******************************************************************
!
!***************************************************************************************************
!use TMDCounters
use TubePotMono
use iso_c_binding, only : c_int, c_double, c_char
implicit none
@ -38,13 +37,12 @@ contains !**********************************************************************
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
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
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 )
@ -85,14 +83,14 @@ contains !**********************************************************************
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
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
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
@ -174,8 +172,9 @@ contains !**********************************************************************
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
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

25
lib/mesont/TPMM1.f90
View File

@ -15,9 +15,8 @@
module TPMM1 !**************************************************************************************
!
! TMD Library: Combined/Weighted potential of type 3
! Combined/Weighted potential of type 1.
!
! Weighting functions are the same as in potential of type 2.
! Calculation of the combined potential is based on the 'extended' chain.
!
!---------------------------------------------------------------------------------------------------
@ -28,7 +27,6 @@ module TPMM1 !******************************************************************
!
!***************************************************************************************************
!use TMDCounters
use TubePotMono
use iso_c_binding, only : c_int, c_double, c_char
implicit none
@ -37,8 +35,8 @@ implicit none
! Constants
!---------------------------------------------------------------------------------------------------
! Maximal length of a segment chain
integer(c_int), parameter :: TPM_MAX_CHAIN = 100
! Maximum length of a segment chain
integer(c_int), parameter :: TPM_MAX_CHAIN = 100
!---------------------------------------------------------------------------------------------------
! Numerical parameters
@ -104,7 +102,7 @@ contains !**********************************************************************
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 ) !!!!!!!!
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
@ -154,19 +152,17 @@ contains !**********************************************************************
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
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
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 )
@ -206,7 +202,6 @@ contains !**********************************************************************
end if
if ( CaseID == 0 ) then
! C_TPM_1 = C_TPM_1 + 1
TPMInteractionFC1 = IntSigna
Q = Qa
U = Ua
@ -218,7 +213,6 @@ contains !**********************************************************************
P1 = P1a + QX
P2 = P2a + QX
else if ( CaseID == 2 ) then
! C_TPM_0 = C_TPM_0 + 1
TPMInteractionFC1 = IntSignb
Q = Qb
U = Ub
@ -229,7 +223,6 @@ contains !**********************************************************************
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
@ -248,16 +241,16 @@ contains !**********************************************************************
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 )
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
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
integer(c_int) :: i, j
real(c_double) :: Q, WW, DD
!-------------------------------------------------------------------------------------------
Q1 = 0.0d+00

100
lib/mesont/TubePotBase.f90
View File

@ -15,8 +15,7 @@
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.
!
!---------------------------------------------------------------------------------------------------
!
@ -33,7 +32,7 @@ module TubePotBase !************************************************************
! -- 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.
!
!***************************************************************************************************
@ -46,11 +45,11 @@ 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(c_int), parameter :: TP_POT_MONO_R = 0
integer(c_int), parameter :: TP_POT_POLY_R = 1
! Maximal number of elements in corresponding tables
integer(c_int), parameter :: TPBNMAX = 2001
integer(c_int), parameter :: TPBNMAX = 2001
! Numerical constants
real(c_double), parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5
@ -58,12 +57,12 @@ implicit none
! Mass of C atom
real(c_double), 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)
! 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)
@ -71,15 +70,13 @@ implicit none
! Specific heat of carbon nanotubes
real(c_double), parameter :: TPBSHcc = 600.0d+00 / K_MDCU ! (eV/(Da*K))
! Cutoff distances for interactomic potential and transfer function
! Cutoff distances for the 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)
! 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)
@ -87,46 +84,46 @@ implicit none
! 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 ()
! Set to .true. to generate diagnostic and warning messages
logical :: TPErrCheck = .true.
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(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
! Physical parameters of the interatomic potential and atoms distribution at the surface
! Parameters of the interatomic potential and atoms distribution at the surface
! of the tube
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(c_double) :: TPBM = TPBMc ! Mass of an atom (Da)
real(c_double) :: TPBE = TPBEcc ! Depth of the energy well in (12-6) LJ interatomic potential (eV)
real(c_double) :: TPBS = TPBScc ! Sigma parameter of (12-6) LJ 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(c_double) :: TPBRmin = TPBRmincc ! (A)
real(c_double) :: TPBRcutoff = TPBRcutoffcc ! (A)
real(c_double) :: TPBRcutoff1 = TPBRcutoff1cc ! (A)
real(c_double) :: TPBRmin = TPBRmincc ! (A)
real(c_double) :: TPBRcutoff = TPBRcutoffcc ! (A)
real(c_double) :: TPBRcutoff1 = TPBRcutoff1cc ! (A)
! Physical parameters of the transfer function
! Parameters of the transfer function
real(c_double) :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A)
real(c_double) :: TPBQRcutoff1 = TPBQRcutoff1cc ! (A)
real(c_double) :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A)
real(c_double) :: 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(c_double) :: TPBE4, TPBE24, TPBDRcutoff, TPBQDRcutoff
real(c_double) :: TPBQR0 ! Constant-value distance for the transfer function (A)
! Table of inter-particle potential, force, and transfer function
integer(c_int) :: TPBN = TPBNMAX
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
contains !******************************************************************************************
integer(c_int) function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!TPBsizeof = sizeof ( TPBU ) + sizeof ( TPBdUdR )
integer(c_int) function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TPBsizeof = 8 * ( size ( TPBQ ) + size ( TPBU ) + size ( TPBdUdR ) )
end function TPBsizeof !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -134,11 +131,11 @@ contains !**********************************************************************
! Interpolation
!---------------------------------------------------------------------------------------------------
real(c_double) function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, RR
integer(c_int) :: i
integer(c_int) :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
@ -155,11 +152,11 @@ contains !**********************************************************************
TPBQInt0 = TPBQ(i) * Z + TPBQ(i+1) * RR
end function TPBQInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, RR
integer(c_int) :: i
integer(c_int) :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
@ -181,7 +178,7 @@ contains !**********************************************************************
real(c_double), intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, RR
integer(c_int) :: i
integer(c_int) :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
@ -204,7 +201,7 @@ contains !**********************************************************************
! Calculation
!---------------------------------------------------------------------------------------------------
real(c_double) function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, t, S
@ -226,7 +223,7 @@ contains !**********************************************************************
endif
end function TPBQCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: R
!-------------------------------------------------------------------------------------------
real(c_double) :: Z, t, S
@ -284,29 +281,6 @@ 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
!---------------------------------------------------------------------------------------------------

399
lib/mesont/TubePotMono.f90
View File

@ -15,35 +15,35 @@
module TubePotMono !********************************************************************************
!
! TMD Library: Approximate tubular potentials and transfer functions for mono-radius tubes
! Approximate tubular potentials and transfer functions for mono-radius tubes.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020
!
!---------------------------------------------------------------------------------------------------
!
! Four potentials and transfer functions are calculated in this module:
!
! 1. SSTP (segment - semi-infinite tube parallel). It gives a linear density of the potential along
! the segment axis which produced by a parallel semi-infinite tube. 2D tables for this potential
! are generated at initialization or can be loaded from a file
! 1. SSTP (segment - semi-infinite tube parallel): Linear density of the potential along
! the segment axis which is produced by a parallel semi-infinite tube. 2D tables for this potential
! are generated at initialization or can be loaded from a file.
!
! 2. STP (segment - tube parallel). It gives a linear density of the potential along the segment axis
! which produced by a parallel infinite tubes. This is only a particular case of the SSTP potential,
! but it is considered separately for computational effiency. 1D tables of this potential are taken
! 2. STP (segment - tube parallel): Linear density of the potential along the segment axis
! which is produced by a parallel infinite tubes. This is only a particular case of the SSTP potential,
! but it is considered separately for computational efficiency. 1D tables of this potential are taken
! from 2D tables of SSTP potential.
!
! 3. SST (segment - semi-infinite tube). It gives a potential for a segment produced by a arbitrary-
! oriented semi-infinite tube. Data of this potential can not be kept in 2D tabels, therefore all
! 3. SST (segment - semi-infinite tube): Potential for a segment produced by an arbitrary-
! oriented semi-infinite tube. This potential can not be kept in 2D tables, therefore, all
! data are calculated 'on fly' with the help of SSTP potential and numerical integration along the
! segment axis
!
! 4. ST (segment - tube). It gives a potential for a segment produced by a arbitrary-oriented
! 4. ST (segment - tube): Potential for a segment produced by an arbitrary-oriented
! infinitely long tube. 2D tables for this potential are generated at initialization or can be
! loaded from a file
! loaded from a file.
!
!***************************************************************************************************
@ -72,8 +72,8 @@ implicit none
!---------------------------------------------------------------------------------------------------
integer(c_int) :: TPMStartMode = 1
character*512 :: TPMSSTPFile = 'TPMSSTP.xrs'
character*512 :: TPMAFile = 'TPMA.xrs'
character*512 :: TPMFile = 'MESONT-TABTP.xrs'
integer(c_int) :: TPMUnitID ! Unit for the tabulated potential file
integer(c_int) :: TPMNZ = TPMNZMAX
integer(c_int) :: TPMNZ1 = TPMNZMAX - 1
@ -85,66 +85,68 @@ implicit none
integer(c_int) :: TPMNX = TPMNXMAX
integer(c_int) :: TPMNX1 = TPMNXMAX - 1
integer :: TPMChiIndM ! Chirality index M
integer :: TPMChiIndN ! Chirality index N
real(c_double) :: TPMR1
real(c_double) :: TPMR2
integer :: TPMChiIndM ! Chirality index M
integer :: TPMChiIndN ! Chirality index N
real(c_double) :: TPMR1
real(c_double) :: TPMR2
real(c_double) :: TPMHmax
real(c_double) :: TPMDH
real(c_double) :: TPMHmax
real(c_double) :: TPMDH
! Parameters of empirical correction functions
integer(c_int) :: TPMAN = 20
real(c_double) :: TPMAHmin
real(c_double) :: TPMAHmax
real(c_double) :: TPMADH
real(c_double), dimension(0:TPMNHMAX-1) :: TPMAH, TPMAF, TPMAFxx
real(c_double) :: TPMAHmin
real(c_double) :: TPMAHmax
real(c_double) :: TPMADH
real(c_double), dimension(0:TPMNHMAX-1) :: TPMAH, TPMAF, TPMAFxx
! Fitting parameters that depend on the SWCNT chirality
real(c_double) :: TPMCaA = 0.22d+00 ! 0.22 for (10,10) CNTs
real(c_double) :: TPMCeA = 0.35d+00 ! 0.35 for (10,10) CNTs
real(c_double) :: TPMAHmin0 = 10.0d+00 ! 10.0 A for (10,10) CNTs
real(c_double) :: TPMCaA = 0.22d+00 ! 0.22 for (10,10) CNTs
real(c_double) :: TPMCeA = 0.35d+00 ! 0.35 for (10,10) CNTs
real(c_double) :: TPMAHmin0 = 10.0d+00 ! 10.0 A for (10,10) CNTs
! Parameters of SSTP integrator
real(c_double) :: TPMDE
real(c_double), dimension(0:TPMNEMAX-1) :: TPMCE, TPMSE
real(c_double) :: TPMDE
real(c_double), dimension(0:TPMNEMAX-1) :: TPMCE, TPMSE
! Additional parameters for SSTP potential
real(c_double) :: TPMSSTPDelta = 0.25d+00
real(c_double) :: TPMSSTPDelta = 0.25d+00
integer(c_int) :: TPMSSTPNH
integer(c_int) :: TPMSSTPNX
real(c_double) :: TPMSSTPX1
real(c_double) :: TPMSSTPXmax
real(c_double) :: TPMSSTPDX
real(c_double) :: TPMSSTPX1
real(c_double) :: TPMSSTPXmax
real(c_double) :: TPMSSTPDX
real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSSTPG
real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy
real(c_double), dimension(0:TPMNHMAX-1) :: TPMSSTPH
real(c_double), dimension(0:TPMNXMAX-1) :: TPMSSTPX
real(c_double), dimension(0:TPMNHMAX-1) :: TPMSSTPH
real(c_double), dimension(0:TPMNXMAX-1) :: TPMSSTPX
! Additional parameters for STP potential
! In calcuation of this potential also some parameters of SSTP potential are used
! In calculations of this potential, some parameters of SSTP potential are also used.
! In particular, STP potential has no its own integrator. All data comes from SSTP integrator.
! It does not result in any computational inefficiency unless the STP potential is used without SSTP one.
integer(c_int) :: TPMNN = 10
real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPG
real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPF, TPMSTPFxx
real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPG
real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPF, TPMSTPFxx
! Parameters for ST potential
real(c_double) :: TPMSTDelta = 1.0d+00 ! Minimal gap dh for ST-potential
integer(c_int) :: TPMSTNXS = 10 ! Number of subdivisions for every grid step in ST-integrator
real(c_double) :: TPMSTXmax
real(c_double) :: TPMSTH1
real(c_double) :: TPMSTH2
real(c_double) :: TPMSTDH12
! Minimum gap dh for ST-potential
real(c_double) :: TPMSTDelta = 1.0d+00
! Number of subdivisions for every grid step in ST-integrator
integer(c_int) :: TPMSTNXS = 10
real(c_double) :: TPMSTXmax
real(c_double) :: TPMSTH1
real(c_double) :: TPMSTH2
real(c_double) :: TPMSTDH12
real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSTG
real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy
@ -155,21 +157,22 @@ implicit none
! Height switch (at H=0 in SST-potential)
integer(c_int) :: TPMHSwitch = 0 ! 1, use h-switch; 0, do not use the switch
real(c_double) :: TPMHS = 3.0d+00 ! Switch height, Angstrom
real(c_double) :: TPMHS = 3.0d+00 ! Switch height, Angstrom
! Angle switch
integer(c_int) :: TPMASwitch = 0 ! 1, use a-switch; 0, do not use the switch
real(c_double) :: TPMAS = 3.0d+00 ! Switch angle, degree
real(c_double) :: TPMASMin
real(c_double) :: TPMASMax
real(c_double) :: TPMASDelta
real(c_double) :: TPMAS = 3.0d+00 ! Switch angle, degree
real(c_double) :: TPMASMin
real(c_double) :: TPMASMax
real(c_double) :: TPMASDelta
! These variables are used to print error message if intertube force filed fails
integer(c_int) :: Err_CNT1 = 0, Err_CNT1_Node = 0, Err_CNT2 = 0, Err_CNT2_Node1 = 0, Err_CNT2_Node2 = 0, Err_EType = 0
integer(c_int) :: Err_CNT1 = 0, Err_CNT1_Node = 0, Err_CNT2 = 0, &
Err_CNT2_Node1 = 0, Err_CNT2_Node2 = 0, Err_EType = 0
contains !******************************************************************************************
integer(c_int) function TPMsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TPMsizeof = 8 * ( size ( TPMAH ) + size ( TPMAF ) + size ( TPMAFxx ) &
+ size ( TPMCE ) + size ( TPMSE ) + size ( TPMSSTPG ) + size ( TPMSSTPF ) &
+ size ( TPMSSTPFxx ) + size ( TPMSSTPFyy ) + size ( TPMSSTPFxxyy ) &
@ -183,22 +186,23 @@ contains !**********************************************************************
!---------------------------------------------------------------------------------------------------
subroutine PrintTPErrMsg () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!write ( TPErrMsg, fmt = '(a,i8,a,i8,a,i8,a,i8,a,i8,a,i1)' ) 'CNT ', Err_CNT1, ' [', Err_CNT1_Node,'] with CNT ', Err_CNT2, ' [', Err_CNT2_Node1, ', ', Err_CNT2_Node2, '] E=', Err_EType
!write ( TPErrMsg, fmt = '(a,i8,a,i8,a,i8,a,i8,a,i8,a,i1)' ) 'CNT ', Err_CNT1, ' [', &
! Err_CNT1_Node,'] with CNT ', Err_CNT2, ' [', Err_CNT2_Node1, ', ', Err_CNT2_Node2, '] E=', Err_EType
!call PrintStdLogMsg ( TPErrMsg )
end subroutine PrintTPErrMsg !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! SSTP: Linear potential density for the tube interacting with parallel semi-infinte tube
! SSTP: Linear potential density for the tube interacting with parallel semi-infinite tube
!---------------------------------------------------------------------------------------------------
subroutine TPMSSTPIntegrator ( Q, U, H, D ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function calculates the transfer function Q and potential U between an infinitely long
! tube and a cross-section of another parallel tube for given height H and displacemnet D.
! tube and a cross-section of another parallel tube for given height H and displacement D.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), intent(in) :: H, D
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j, k
integer(c_int) :: i, j, k
real(c_double) :: C, Zmin, Zmax, DZ, R1X, R1Y, R2X, R2Y, R2Z, R, Rcutoff2
!-------------------------------------------------------------------------------------------
Q = 0.0d+00
@ -236,14 +240,14 @@ contains !**********************************************************************
U = U * sqr ( TPBD ) * C
end subroutine TPMSSTPIntegrator !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTPInt0 ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTPInt0 ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the transfer function Q and potential U for the SSTP potential
! calculated with interpolation in the table without switch
! calculated by interpolation in the table without switch.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), intent(in) :: H, X
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
integer(c_int) :: i, j
real(c_double) :: XX
!-------------------------------------------------------------------------------------------
i = 1 + int ( H / TPMDH )
@ -270,13 +274,13 @@ contains !**********************************************************************
XX = X
end if
Q = CalcLinFun2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPG )
U = CalcSpline2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy )
U = CalcSpline2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy )
TPMSSTPInt0 = 1
end function TPMSSTPInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTPInt0S ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTPInt0S ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the transfer function Q and potential U for the SSTP potential
! calculated with interpolation in the table and switch to the case of zero H
! calculated by interpolation in the table and switch to the case of zero H.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), intent(in) :: H, X
@ -300,14 +304,14 @@ contains !**********************************************************************
end if
end function TPMSSTPInt0S !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTPInt1 ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the transfer function Q, potential U, and derivarives Uh=dU/dH and
! Ux=dU/dX for the SSTP potential calculated with interpolation in the table without switch
integer(c_int) function TPMSSTPInt1 ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the transfer function Q, potential U, and derivatives Uh=dU/dH and
! Ux=dU/dX for the SSTP potential calculated by interpolation in the table without switch
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U, Uh, Ux
real(c_double), intent(in) :: H, X
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
integer(c_int) :: i, j
real(c_double) :: XX
!-------------------------------------------------------------------------------------------
i = 1 + int ( H / TPMDH )
@ -336,19 +340,20 @@ contains !**********************************************************************
XX = X
end if
Q = CalcLinFun2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPG )
call CalcSpline2_1 ( U, Uh, Ux, i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy )
call CalcSpline2_1 ( U, Uh, Ux, i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, &
TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy )
TPMSSTPInt1 = 1
end function TPMSSTPInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTPInt1S ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the transfer function Q, potential U, and derivarives Uh=dU/dH and
! Ux=dU/dX for the SSTP potential calculated with interpolation in the table and switch to
integer(c_int) function TPMSSTPInt1S ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the transfer function Q, potential U, and derivatives Uh=dU/dH and
! Ux=dU/dX for the SSTP potential calculated by interpolation in the table and switch to
! the case of zero H.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U, Uh, Ux
real(c_double), intent(in) :: H, X
!-------------------------------------------------------------------------------------------
integer(c_int) :: IntSign
integer(c_int) :: IntSign
real(c_double) :: t, W, W1, dWdH, Qa, Ua, Uha, Uxa
!-------------------------------------------------------------------------------------------
if ( TPMHSwitch == 0 ) then
@ -372,28 +377,26 @@ contains !**********************************************************************
end function TPMSSTPInt1S !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPMSSTPWrite () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function writes the table of the SSTP potential to the disk file
! This function writes the table of the SSTP potential to a disk file.
!-------------------------------------------------------------------------------------------
integer(c_int) :: Fuid, i, j
integer(c_int) :: i, j
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( TPMSSTPFile, 'wt', '' )
write ( unit = Fuid, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMNH1, TPMNX1
write ( unit = TPMUnitID, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMNH1, TPMNX1
do i = 0, TPMNH1
do j = 0, TPMNX1
if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) write ( unit = Fuid, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j)
if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) &
write ( unit = TPMUnitID, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j)
end do
end do
call CloseFile ( Fuid )
end subroutine TPMSSTPWrite !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPMSSTPRead () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function reads the table of the SSTP potential from the disk file
! This function reads the table of the SSTP potential from a disk file.
!-------------------------------------------------------------------------------------------
integer(c_int) :: Fuid, i, j
integer(c_int) :: i, j
integer(c_int) :: iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1
!-------------------------------------------------------------------------------------------
Fuid = OpenFile ( TPMSSTPFile, 'rt', '' )
read ( unit = Fuid, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1
read ( unit = TPMUnitID, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1
if ( iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN ) then
print *, 'ERROR in [TPMSSTPRead]: iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN'
stop
@ -404,18 +407,18 @@ contains !**********************************************************************
end if
do i = 0, TPMNH1
do j = 0, TPMNX1
if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) read ( unit = Fuid, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j)
if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) &
read ( unit = TPMUnitID, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j)
end do
end do
call CloseFile ( Fuid )
end subroutine TPMSSTPRead !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPMSSTPInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function calculates the table of the SSTP potential
! This function calculates the table of the SSTP potential.
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
integer(c_int) :: i, j
real(c_double) :: E
character(c_char) :: Msg
character(c_char) :: Msg
real(c_double), dimension(0:TPMNMAX-1) :: FF, DD, MM, K0, K1, K2
!-------------------------------------------------------------------------------------------
TPMDE = M_2PI / TPMNE
@ -441,7 +444,8 @@ contains !**********************************************************************
do j = 0, TPMNX1
if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) then
call TPMSSTPIntegrator ( TPMSSTPG(i,j), TPMSSTPF(i,j), TPMSSTPH(i), TPMSSTPX(j) )
print '(2i5,a,e20.10,a,e20.10,a,e20.10,a,e20.10)', i, j, ' H=', TPMSSTPH(i), ', X=', TPMSSTPX(j), ', Q=', TPMSSTPG(i,j), ', U=', TPMSSTPF(i,j)
print '(2i5,a,e20.10,a,e20.10,a,e20.10,a,e20.10)', i, j, ' H=', TPMSSTPH(i), &
', X=', TPMSSTPX(j), ', Q=', TPMSSTPG(i,j), ', U=', TPMSSTPF(i,j)
end if
end do
end do
@ -449,22 +453,23 @@ contains !**********************************************************************
else
call TPMSSTPRead ()
end if
call CreateSpline2Ext ( 3, 3, 3, 3, TPMNH, TPMSSTPNH, TPMNX, TPMSSTPNX, TPMNMAX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy, FF, MM, DD, K0, K1, K2 )
call CreateSpline2Ext ( 3, 3, 3, 3, TPMNH, TPMSSTPNH, TPMNX, TPMSSTPNX, TPMNMAX, TPMSSTPH, TPMSSTPX, &
TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy, FF, MM, DD, K0, K1, K2 )
end subroutine TPMSSTPInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! STP Potential for an infinite tube interacting with a parallel segment. No actual initialization
! is necessary for this potential, since the data are taken from the table for SSTP potenrials.
! STP potential for an infinite tube interacting with a parallel segment. No actual initialization
! is necessary for this potential, since the data are taken from the table for the SSTP potential.
!---------------------------------------------------------------------------------------------------
integer(c_int) function TPMSTPInt0 ( Q, U, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTPInt0 ( Q, U, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the transfer function Q and potential U for the STP potential
! calculated with interpolation in the table
! calculated by interpolation in the table.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), intent(in) :: H
!-------------------------------------------------------------------------------------------
integer(c_int) :: i
integer(c_int) :: i
!-------------------------------------------------------------------------------------------
i = 1 + int ( H / TPMDH )
if ( i < TPMSSTPNH ) then
@ -485,13 +490,13 @@ contains !**********************************************************************
TPMSTPInt0 = 1
end function TPMSTPInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTPInt1 ( Q, U, dUdH, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTPInt1 ( Q, U, dUdH, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the transfer function Q, potential U, and derivative dUdH for
! the STP potential calculated with interpolation in the table
! the STP potential calculated by interpolation in the table.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U, dUdH
real(c_double), intent(in) :: H
integer(c_int) :: i
integer(c_int) :: i
!-------------------------------------------------------------------------------------------
i = 1 + int ( H / TPMDH )
if ( i < TPMSSTPNH ) then
@ -521,8 +526,8 @@ contains !**********************************************************************
end subroutine TPMSTPInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Fitting functions for SST and ST potential.
! This correction functions are choosen empirically to improve accuracy of SST and ST potentials.
! Fitting functions for the SST and ST potentials.
! This correction functions are chosen empirically to improve accuracy of the SST and ST potentials.
!---------------------------------------------------------------------------------------------------
subroutine TPMAInit ( X1_1, X1_2, X2_1, X2_2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -531,16 +536,15 @@ contains !**********************************************************************
real(c_double), dimension(0:2) :: R1_1, R1_2, R2_1, R2_2
real(c_double), dimension(0:2) :: Fa, Ma
real(c_double) :: Qa, Ua, Qb, Ub, X, H, HH, Ucoeff, Uamin, Ubmin
integer(c_int) :: i, j, IntSign, Fuid
integer(c_int) :: i, j, IntSign
real(c_double), dimension(0:TPMNHMAX-1) :: D, K0, K1, K2
integer(c_int) :: iTPMChiIndM, iTPMChiIndN, iTPMAN
integer(c_int) :: iTPMChiIndM, iTPMChiIndN, iTPMAN
!-------------------------------------------------------------------------------------------
TPMAHmin = TPMR1 + TPMR2 + TPMSTDelta
TPMAHmax = TPMR1 + TPMR2 + 0.95d+00 * TPBRcutoff
TPMADH = ( TPMAHmax - TPMAHmin ) / ( TPMAN - 1 )
if ( TPMStartMode == 1 ) then
Fuid = OpenFile ( TPMAFile, 'rt', '' )
read ( unit = Fuid, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMAN
read ( unit = TPMUnitID, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMAN
if ( iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN ) then
print *, 'ERROR in [TPMAInit]: iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN'
stop
@ -551,9 +555,8 @@ contains !**********************************************************************
end if
do i = 0, TPMAN - 1
TPMAH(i) = TPMAHmin + i * TPMADH
read ( unit = Fuid, fmt = * ) TPMAF(i)
read ( unit = TPMUnitID, fmt = * ) TPMAF(i)
end do
call CloseFile ( Fuid )
call CreateSpline1 ( 3, 3, TPMAN, TPMAH, TPMAF, TPMAFxx, D, K0, K1, K2 )
return
end if
@ -583,19 +586,17 @@ contains !**********************************************************************
end do
TPMAF(i) = Uamin / Ubmin
end do
Fuid = OpenFile ( TPMAFile, 'wt', '' )
write ( unit = Fuid, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMAN
write ( unit = TPMUnitID, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMAN
do i = 0, TPMAN - 1
write ( unit = Fuid, fmt = * ) TPMAF(i)
write ( unit = TPMUnitID, fmt = * ) TPMAF(i)
end do
call CloseFile ( Fuid )
call CreateSpline1 ( 3, 3, TPMAN, TPMAH, TPMAF, TPMAFxx, D, K0, K1, K2 )
end subroutine TPMAInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMA0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMA0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: H
!-------------------------------------------------------------------------------------------
integer(c_int) :: i
integer(c_int) :: i
real(c_double) :: A0, t, S
!-------------------------------------------------------------------------------------------
if ( H > TPMAHmax ) then
@ -620,7 +621,7 @@ contains !**********************************************************************
real(c_double), intent(out) :: A, Ah
real(c_double), intent(in) :: H
!-------------------------------------------------------------------------------------------
integer(c_int) :: i
integer(c_int) :: i
real(c_double) :: A0, t, S, dSdH
!-------------------------------------------------------------------------------------------
if ( H > TPMAHmax ) then
@ -646,7 +647,7 @@ contains !**********************************************************************
call CalcSpline1_1 ( A, Ah, i, H, TPMAN, TPMAH, TPMAF, TPMAFxx )
end subroutine TPMA1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMCu0 ( H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMCu0 ( H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the correction function for the magnitude of the potential.
!-------------------------------------------------------------------------------------------
real(c_double), intent(in) :: H, cosA, sinA
@ -655,8 +656,8 @@ contains !**********************************************************************
end function TPMCu0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPMCu1 ( Cu, CuH, CuA, H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Thi subroutine calculates the correction function Cu for magnitude of the potential and
! its derivatives CuH, CuA.
! The subroutine calculates the correction function Cu for the magnitude of the potential and
! its derivatives CuH and CuA.
!-------------------------------------------------------------------------------------------
real(c_double), intent(ouT) :: Cu, CuH, CuA
real(c_double), intent(in) :: H, cosA, sinA
@ -670,7 +671,7 @@ contains !**********************************************************************
CuA = AA * 2.0d+0 * cosA * sinA
end subroutine TPMCu1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMCa0 ( cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMCa0 ( cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the correction function for the argument of the potential.
! If correction is not necessary, it should return sinA.
!-------------------------------------------------------------------------------------------
@ -679,9 +680,9 @@ contains !**********************************************************************
TPMCa0 = sinA / ( 1.0d+00 - TPMCaA * sqr ( sinA ) )
end function TPMCa0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPMCa1 ( Ca, CaA, Ka, KaA, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPMCa1 ( Ca, CaA, Ka, KaA, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This subroutine calculates the correction function Cu for the depth of the potential well
! and its derivatives CuH, CuA. If correction is not necessary, it should return Ca = sinA
! and its derivatives CuH and CuA. If correction is not necessary, it returns Ca = sinA
! and CaA = cosA.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Ca, CaA, Ka, KaA
@ -693,9 +694,9 @@ contains !**********************************************************************
CaA = cosA * Ka + sinA * KaA
end subroutine TPMCa1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMCe0 ( sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMCe0 ( sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the correction function for the argument of the potential.
! If correction is not necessary, it should return sinA.
! If correction is not necessary, it returns sinA.
!-------------------------------------------------------------------------------------------
real(c_double), intent(in) :: sinA
!-------------------------------------------------------------------------------------------
@ -703,7 +704,7 @@ contains !**********************************************************************
end function TPMCe0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPMCe1 ( Ce, CeA, Ke, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! If correction is not necessary, it should return Ce = 1 and CeA = 0.
! If correction is not necessary, it returns Ce = 1 and CeA = 0.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Ce, CeA, Ke
real(c_double), intent(in) :: cosA, sinA
@ -714,24 +715,24 @@ contains !**********************************************************************
end subroutine TPMCe1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! SST Potential for the semi-infinite tube interacting with segment.
! This potential does not need any initialization. All necessry data is taken from tables of the
! SST potential for the semi-infinite tube interacting with segment.
! This potential does not need any initialization. All necessary data is taken from tables of the
! SSTP potential.
!---------------------------------------------------------------------------------------------------
integer(c_int) function TPMSSTPotential ( Q, U, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!!!!!!!!!!!
! This function calculates the transfer function Q and potenial U applyed to a segment
! from asemi-infinte tube based on numerical integration (trapesond rule) along the segment
integer(c_int) function TPMSSTPotential ( Q, U, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!!!!!!
! This function calculates the transfer function Q and potential U applied to a segment
! from a semi-infinite tube based on the numerical integration (trapezoidal rule) along the segment
! axis for non-parallel objects.
! Relative position of the nanotube and segment are given by axial positions of the segment
! ends X1 and X2, height H, cosA= cos(A), where A is the cross-axis angle, and displacement
! D of the nanotube end.
! Relative position of the nanotube and segment is given by axial positions of the segment
! ends X1 and X2, height H, cosA= cos(A), where A is the cross-axis angle, and the displacement
! D of a nanotube end.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), intent(in) :: X1, X2, H, cosA, D
integer(c_int), intent(in) :: N ! Number of nodes for numerical integration
integer(c_int), intent(in) :: N ! Number of nodes for numerical integration
real(c_double) :: sinA, Qs, Us, DX, X, XX, HH, Cu, Ca, Ce
integer(c_int) :: i
integer(c_int) :: i
!-------------------------------------------------------------------------------------------
Q = 0.0d+00
U = 0.0d+00
@ -759,18 +760,18 @@ contains !**********************************************************************
U = Cu * U * DX
end function TPMSSTPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTPotentialPar ( Q, U, R1_1, Laxis1, R2_1, Laxis2, L1, N ) !!!!!!!!!!
! Potential applyed to the segment from the semi-infinte tube is calculated by numerical
! integration (trapesond rule) along the segment axis for parallel objects.
integer(c_int) function TPMSSTPotentialPar ( Q, U, R1_1, Laxis1, R2_1, Laxis2, L1, N ) !!!!!
! Potential for a segment and a semi-infinite tube is calculated by the numerical
! integration (trapezoidal rule) along the segment axis for parallel objects.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U
real(c_double), dimension(0:2), intent(in) :: R1_1, Laxis1, R2_1, Laxis2
real(c_double), intent(in) :: L1
integer(c_int), intent(in) :: N ! Number of nodes for numerical integration
integer(c_int), intent(in) :: N ! Number of nodes for numerical integration
!-------------------------------------------------------------------------------------------
real(c_double) :: Qs, Us, DX, X, S, H
real(c_double), dimension(0:2) :: R1, L12
integer(c_int) :: i
integer(c_int) :: i
!-------------------------------------------------------------------------------------------
DX = L1 / ( N - 1 )
X = 0.0d+00
@ -799,21 +800,21 @@ contains !**********************************************************************
U = U * DX
end function TPMSSTPotentialPar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTForces ( Q, U, F1, F2, Fd, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!!
! Potential and forces applyed to the segment from the semi-infinte tube are calculated
! by numerical integration (trapesond rule) along the segment axis.
integer(c_int) function TPMSSTForces ( Q, U, F1, F2, Fd, X1, X2, H, cosA, D, N ) !!!!!!!!!!!
! Potential and forces applied to the segment from a semi-infinite tube are calculated
! by the numerical integration (trapezoidal rule) along the segment axis.
! Non-parallel case.
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U, Fd
real(c_double), dimension(0:2), intent(out) :: F1, F2
real(c_double), intent(in) :: X1, X2, H, cosA, D
integer(c_int), intent(in) :: N ! Number of nodes for numerical integration
integer(c_int), intent(in) :: N ! Number of nodes for numerical integration
!-------------------------------------------------------------------------------------------
real(c_double) :: DX, sinA
real(c_double) :: Qs, Us, Ush, Usx, Fx, Fy, Fz
real(c_double) :: C, C1, C2, I0, Ih, Ih1, Ih2, Ix, Ix1, X, XX, HH
real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA, Ce, CeA, Ke, Uh, Ua
integer(c_int) :: IntSign, i
integer(c_int) :: IntSign, i
!-------------------------------------------------------------------------------------------
I0 = 0.0d+00
Ih = 0.0d+00
@ -891,20 +892,20 @@ contains !**********************************************************************
Fd = Ce * Ix
end function TPMSSTForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSSTForcesPar ( Q, U, F1, F2, Fd, R1_1, Laxis1, R2_1, Laxis2, L1, N ) !
! Potential and forces applyed to the segment from the semi-infinte tube are calculated by
! numerical integration (trapesond rule) along the segment axis.
! Non-parallel case
integer(c_int) function TPMSSTForcesPar ( Q, U, F1, F2, Fd, R1_1, Laxis1, R2_1, Laxis2, L1, N )
! Potential and forces applied to the segment from a semi-infinite tube are calculated by
! the numerical integration (trapezoidal rule) along the segment axis.
! Parallel case
!-------------------------------------------------------------------------------------------
real(c_double), intent(out) :: Q, U, Fd
real(c_double), dimension(0:2), intent(out) :: F1, F2
real(c_double), dimension(0:2), intent(in) :: R1_1, Laxis1, R2_1, Laxis2
real(c_double), intent(in) :: L1
integer(c_int), intent(in) :: N ! Number of nodes for numerical integration
integer(c_int), intent(in) :: N ! Number of nodes for numerical integration
!-------------------------------------------------------------------------------------------
real(c_double) :: Qs, Us, Ush, Usx, DX, X, S, H, Beta, Gamma
real(c_double), dimension(0:2) :: R1, L12, Fs
integer(c_int) :: i, N1
integer(c_int) :: i, N1
!-------------------------------------------------------------------------------------------
Q = 0.0d+00
U = 0.0d+00
@ -955,14 +956,14 @@ contains !**********************************************************************
end function TPMSSTForcesPar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! ST: Potential for the infinite tube interacting with segment
! ST: Potential for a infinite tube interacting with a segment
!--------------------------------------------------------------------------------------------------
!
! These functions are used to smooth boundaries in (H,X) domain for ST potential
!
real(c_double) function TPMSTXMin0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMSTXMin0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: H
!-------------------------------------------------------------------------------------------
real(c_double) :: X
@ -975,10 +976,11 @@ contains !**********************************************************************
return
end if
X = ( H - TPMSTH1 ) / TPMSTDH12
TPMSTXMin0 = sqrt ( TPMSTH2 * TPMSTH2 - H * H ) * ( 1.0d+00 - X * X * X * ( 3.0d+00 * X * ( 2.0d+00 * X - 5.0d+00 ) + 10.0d+00 ) )
TPMSTXMin0 = sqrt ( TPMSTH2 * TPMSTH2 - H * H ) &
* ( 1.0d+00 - X * X * X * ( 3.0d+00 * X * ( 2.0d+00 * X - 5.0d+00 ) + 10.0d+00 ) )
end function TPMSTXMin0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMSTXMax0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function TPMSTXMax0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: H
!-------------------------------------------------------------------------------------------
TPMSTXMax0 = sqrt ( TPMSTXMax * TPMSTXMax - H * H )
@ -1025,7 +1027,7 @@ contains !**********************************************************************
real(c_double), intent(in) :: H, X, DX
!-------------------------------------------------------------------------------------------
real(c_double) :: FFx, HH, DDX
integer(c_int) :: IntSign
integer(c_int) :: IntSign
!-------------------------------------------------------------------------------------------
DDX = 0.5 * DX
G = G + Q * DDX
@ -1041,11 +1043,11 @@ contains !**********************************************************************
end if
end subroutine TPMSTIntegrator !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTInt0 ( G, F, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTInt0 ( G, F, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: G, F
real(c_double), intent(in) :: H, X
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
integer(c_int) :: i, j
real(c_double) :: S, XA, XXX, XXXX, XMin, XMax
!-------------------------------------------------------------------------------------------
if ( H > TPMHmax ) then
@ -1087,11 +1089,11 @@ contains !**********************************************************************
TPMSTInt0 = 1
end function TPMSTInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTInt1 ( G, F, Fh, Fx, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTInt1 ( G, F, Fh, Fx, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(inout) :: G, F, Fh, Fx
real(c_double), intent(in) :: H, X
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
integer(c_int) :: i, j
real(c_double) :: S, XA, DX, XXX, XXXX, XMin, XMax, dXMindH, dXMaxdH
!-------------------------------------------------------------------------------------------
if ( H > TPMHmax ) then
@ -1136,7 +1138,8 @@ contains !**********************************************************************
j = 1 + int ( XXXX * TPMNX1 )
end if
G = S * CalcLinFun2_0 ( i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTG )
call CalcSpline2_1 ( F, Fh, Fx, i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy )
call CalcSpline2_1 ( F, Fh, Fx, i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, &
TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy )
Fx = Fx / DX
Fh = Fh - Fx * ( dXMaxdH * XXX + dXMindH * ( 1.0d+00 - XXX ) )
F = F * S
@ -1144,10 +1147,10 @@ contains !**********************************************************************
TPMSTInt1 = 1
end function TPMSTInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTPotential ( Q, U, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTPotential ( Q, U, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: Q, U
real(c_double), intent(in) :: X1, X2, H, cosA
integer(c_int), intent(in) :: CaseID
integer(c_int), intent(in) :: CaseID
!-------------------------------------------------------------------------------------------
real(c_double) :: sinA, GG1, GG2, FF1, FF2, Ca, Cu
!-------------------------------------------------------------------------------------------
@ -1166,17 +1169,17 @@ contains !**********************************************************************
U = Cu * ( FF2 - FF1 ) / Ca
end function TPMSTPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTForces ( Q, U, F1, F2, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMSTForces ( Q, U, F1, F2, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!
real(c_double), intent(out) :: Q, U
real(c_double), dimension(0:2), intent(out) :: F1, F2
real(c_double), intent(in) :: X1, X2, H, cosA
integer(c_int), intent(in) :: CaseID
integer(c_int), intent(in) :: CaseID
!-------------------------------------------------------------------------------------------
real(c_double) :: DX, sinA
real(c_double) :: GG1, GG2, FF1, FF2, Fh1, Fh2, Fx1, Fx2
real(c_double) :: B, C, D
real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA
integer(c_int) :: IntSign1, IntSign2
integer(c_int) :: IntSign1, IntSign2
!-------------------------------------------------------------------------------------------
DX = X2 - X1
if ( CaseID == MD_LINES_PAR ) then
@ -1230,13 +1233,13 @@ contains !**********************************************************************
integer(c_int) function TPMSTForceTorque( Qi, Ui, Fi, Ti, Q, U, F, T, Psi, PsiA, Cap, L, H, cosA, CaseID )
real(c_double), intent(out) :: Qi, Ui, Fi, Ti, Q, U, F, T, Psi, PsiA, Cap
real(c_double), intent(in) :: L, H, cosA
integer(c_int), intent(in) :: CaseID
integer(c_int), intent(in) :: CaseID
!-------------------------------------------------------------------------------------------
real(c_double) :: L2, sinA
real(c_double) :: GG, FF, Fh, Fx, GGi, FFi, Fhi, Fxi
real(c_double) :: B, C, D
real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA
integer(c_int) :: IntSign
integer(c_int) :: IntSign
!-------------------------------------------------------------------------------------------
if ( CaseID == MD_LINES_PAR ) then
TPMSTForceTorque = TPMSTPInt1 ( Q, U, F, H )
@ -1296,7 +1299,7 @@ contains !**********************************************************************
subroutine TPMSTInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) :: X, Q, U, DX, DDX, XMin, XMax
integer(c_int) :: i, j, k
integer(c_int) :: i, j, k
real(c_double), dimension(0:TPMNMAX-1) :: FF, DD, MM, K0, K1, K2
!-------------------------------------------------------------------------------------------
TPMSTH1 = TPMR1 + TPMR2
@ -1330,12 +1333,13 @@ contains !**********************************************************************
if ( j < TPMNX1 ) DX = ( XMax - XMin ) * ( TPMSTX(j+1) - TPMSTX(j) ) / TPMSTNXS
end do
end do
call CreateSpline2 ( 3, 3, 3, 3, TPMNH, TPMNX, TPMNMAX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy, FF, MM, DD, K0, K1, K2 )
call CreateSpline2 ( 3, 3, 3, 3, TPMNH, TPMNX, TPMNMAX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, &
TPMSTFyy, TPMSTFxxyy, FF, MM, DD, K0, K1, K2 )
end subroutine TPMSTInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Interaction functions: They can be used for calculation of the potential and forces between a
! segment and infinte or semi-infinite nanotube.
! segment and an infinite or semi-infinite nanotube.
!---------------------------------------------------------------------------------------------------
subroutine TPMSegmentForces ( F2_1, F2_2, F1_1, F1_2, R1_1, R1_2, R2, Laxis2, L2 ) !!!!!!!!!
@ -1346,11 +1350,11 @@ contains !**********************************************************************
real(c_double), dimension(0:2) :: F, M, RR
!-------------------------------------------------------------------------------------------
RR = R1_1 - R2
! Taking into account periodic boundaries
! Taking into account periodic boundary conditions
call ApplyPeriodicBC ( RR )
call V3_V3xxV3 ( M, RR, F1_1 )
RR = R1_2 - R2
! Taking into account periodic boundaries
! Taking into account periodic boundary conditions
call ApplyPeriodicBC ( RR )
call V3_V3xxV3 ( F, RR, F1_2 )
M = - ( M + F )
@ -1359,23 +1363,23 @@ contains !**********************************************************************
end subroutine TPMSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Interaction of a segment with semi-infinite or infinite tube
! Interaction of a segment with a semi-infinite or infinite tube
!
integer(c_int) function TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, SType2 )
! SType2 in the type of the second segment:
! SType2 == 0, internal segment
! Stype2 == 1, point R2_1 is the end of the tube
! Stype2 == 2, point R2_2 in the end of the tube
! SType2 == 0, internal segment;
! Stype2 == 1, point R2_1 is the end of the tube;
! Stype2 == 2, point R2_2 in the end of the tube.
!-------------------------------------------------------------------------------------------
real(c_double), intent(inout) :: Q, U, Fd
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) :: SType2
real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, Ly, DR, F1_1a, F1_2a, F1_1b, F1_2b
real(c_double) :: H, cosA, D1, D2, L1, L2, cosA2, t, W, W1, dWdt, Qa, Ua, Qb, Ub, Fda, Fdb, FF
integer(c_int) :: GeomID, SwitchID, S, IntSigna, IntSignb
integer(c_int) :: SType2
real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, Ly, DR, F1_1a, F1_2a, F1_1b, F1_2b
real(c_double) :: H, cosA, D1, D2, L1, L2, cosA2, t, W, W1, dWdt, Qa, Ua, Qb, Ub, Fda, Fdb, FF
integer(c_int) :: GeomID, SwitchID, S, IntSigna, IntSignb
!-------------------------------------------------------------------------------------------
R1 = 0.5d+00 * ( R1_1 + R1_2 )
R2 = 0.5d+00 * ( R2_1 + R2_2 )
@ -1454,9 +1458,11 @@ contains !**********************************************************************
F1_2b = 0.0d+00
end if
else if ( Stype2 == 1 ) then
IntSignb = TPMSSTForcesPar ( Qb, Ub, F1_1b, F1_2b, Fdb, R1_1, Laxis1, R2_1, Laxis2, 2.0d+00 * L1, TPMNN )
IntSignb = TPMSSTForcesPar ( Qb, Ub, F1_1b, F1_2b, Fdb, R1_1, Laxis1, R2_1, Laxis2, &
2.0d+00 * L1, TPMNN )
else
IntSignb = TPMSSTForcesPar ( Qb, Ub, F1_1b, F1_2b, Fdb, R1_1, Laxis1, R2_2, Laxis2, 2.0d+00 * L1, TPMNN )
IntSignb = TPMSSTForcesPar ( Qb, Ub, F1_1b, F1_2b, Fdb, R1_1, Laxis1, R2_2, Laxis2, &
2.0d+00 * L1, TPMNN )
end if
end if
@ -1486,11 +1492,11 @@ contains !**********************************************************************
if ( IntSigna > 0 .or. IntSignb > 0 ) TPMInteractionF = 1
end if
! Calculation of forces for the comlimentary tube
! Calculation of forces for the complimentary tube
if ( SType2 == 2 ) Laxis2 = - Laxis2
call TPMSegmentForces ( F2_1, F2_2, F1_1, F1_2, R1_1, R1_2, R2, Laxis2, 2.0d+00 * L2 )
! After the previous subroutine F2_1*Laxis2 = F2_2*Laxis2, but this is not true for the semi-infinite tube.
! The force along the tube sould be applied to the end of the tube, while for the
! After the previous subroutine call, F2_1*Laxis2 = F2_2*Laxis2, but this is not true for a semi-infinite tube.
! The force along the tube should be applied to the end of the tube, while for the
! another point corresponding force is equal to zero.
if ( SType2 == 1 ) then
FF = S_V3xV3 ( F2_1, Laxis2 )
@ -1505,14 +1511,14 @@ contains !**********************************************************************
end if
end function TPMInteractionF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMInteractionU ( Q, U, R1_1, R1_2, R2_1, R2_2, SType2 ) !!!!!!!!!!!!!!!!
integer(c_int) function TPMInteractionU ( Q, U, R1_1, R1_2, R2_1, R2_2, SType2 ) !!!!!!!!!!!
real(c_double), intent(inout) :: Q, U
real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2
integer(c_int), intent(in) :: SType2
integer(c_int), intent(in) :: SType2
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, DR
real(c_double) :: H, cosA, D1, D2, L1, L2, cosA2, t, W, Qa, Ua, Qb, Ub
integer(c_int) :: GeomID, SwitchID, IntSigna, IntSignb
integer(c_int) :: GeomID, SwitchID, IntSigna, IntSignb
!-------------------------------------------------------------------------------------------
R1 = 0.5d+00 * ( R1_1 + R1_2 )
R2 = 0.5d+00 * ( R2_1 + R2_2 )
@ -1588,10 +1594,10 @@ contains !**********************************************************************
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) :: SType2
integer(c_int), intent(in) :: SType2
real(c_double), intent(in) :: Delta
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j, IntSign
integer(c_int) :: i, j, IntSign
real(c_double) :: QQ, DD, D2
real(c_double), dimension(0:1,0:2) :: U1_1, U1_2, U2_1, U2_2
real(c_double), dimension(0:2) :: RR
@ -1635,14 +1641,14 @@ contains !**********************************************************************
!---------------------------------------------------------------------------------------------------
subroutine TPMInit ( ChiIndM, ChiIndN ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: ChiIndM, ChiIndN
integer(c_int), intent(in) :: ChiIndM, ChiIndN
real(c_double) :: RT, DX
character*512 :: PDate
!-------------------------------------------------------------------------------------------
TPPotType = TP_POT_MONO_R
! Here we calculate the radius of nanotubes
RT = TPBAcc * sqrt ( 3.0d+00 * ( ChiIndM * ChiIndM + ChiIndN * ChiIndN + ChiIndM * ChiIndN ) ) / M_2PI;
!print *, '(a,i3,a,i3,a,e18.10,a)', 'TPM is iniatized for (', ChiIndM, ',', ChiIndN, ') CNTs, RT = ', RT, ' A'
RT = TPBAcc * sqrt ( 3.0d+00 * ( ChiIndM * ChiIndM + ChiIndN * ChiIndN + ChiIndM * ChiIndN ) ) / M_2PI
TPMChiIndM = ChiIndM
TPMChiIndN = ChiIndN
@ -1660,6 +1666,21 @@ contains !**********************************************************************
TPMASMin = sqr ( cos ( rad ( TPMAS ) ) )
TPMASMax = 1.0d+00 - TPGeomPrec
TPMASDelta = TPMASMax - TPMASMin
if ( TPMStartMode == 1 ) then
TPMUnitID = OpenFile ( TPMFile, 'rt', '' )
read ( unit = TPMUnitID, fmt = '()' )
read ( unit = TPMUnitID, fmt = '()' )
read ( unit = TPMUnitID, fmt = '()' )
else
TPMUnitID = OpenFile ( TPMFile, 'wt', '' )
call fdate( PDate )
write ( unit = TPMUnitID, fmt = '(a,a)' ) 'DATE ', PDate
write ( unit = TPMUnitID, fmt = '(a,i3,a,i3,a)' ) &
'Tabulated data of the tubular potential for (', ChiIndM, ',', ChiIndN, ') CNTs'
write ( unit = TPMUnitID, fmt = '(a)' ) &
'A. N. Volkov, L. V. Zhigilei, J. Phys. Chem. C 114, 5513-5531, 2010. doi: 10.1021/jp906142h'
end if
call TPMSSTPInit ()
@ -1669,6 +1690,8 @@ contains !**********************************************************************
call TPMAInit ( - DX, DX, - DX, DX )
call TPMSTInit ()
call CloseFile ( TPMUnitID )
end subroutine TPMInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

43
lib/mesont/TubePotTrue.f90
View File

@ -25,7 +25,7 @@ module TubePotTrue !************************************************************
!
!---------------------------------------------------------------------------------------------------
!
! This module implements calculation of true potential and transfer functions for interaction
! This module implements calculation of the true potential and transfer functions for interaction
! between two cylinder segments of nanotubes by direct integration over the surfaces of both
! segments.
!
@ -52,7 +52,7 @@ implicit none
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
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
@ -105,7 +105,7 @@ contains !**********************************************************************
type(TPTSEG), intent(inout) :: S
!-------------------------------------------------------------------------------------------
real(c_double) :: X, Eps
integer(c_int) :: i, j
integer(c_int) :: i, j
!-------------------------------------------------------------------------------------------
X = - S%L / 2.0
call RotationMatrix3 ( S%M, S%Psi, S%Theta, S%Phi )
@ -120,7 +120,7 @@ contains !**********************************************************************
end subroutine TPTCalcSegNodeTable !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTSetSegPosition1 ( S, Rcenter, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
type(TPTSEG), intent(inout) :: S
real(c_double), dimension(0:2), intent(in) :: Rcenter, Laxis
real(c_double), intent(in) :: L
!-------------------------------------------------------------------------------------------
@ -135,7 +135,7 @@ contains !**********************************************************************
end subroutine TPTSetSegPosition1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTSetSegPosition2 ( S, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
type(TPTSEG), intent(inout) :: S
real(c_double), dimension(0:2), intent(in) :: R1, R2
!-------------------------------------------------------------------------------------------
real(c_double), dimension(0:2) :: R, Laxis
@ -148,10 +148,10 @@ contains !**********************************************************************
call TPTSetSegPosition1 ( S, R, Laxis, L )
end subroutine TPTSetSegPosition2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S1, S2
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
integer(c_int) :: i, j
real(c_double) :: L1, L2, Displacement, D
real(c_double), dimension(0:2) :: Laxis, Q, R
!-------------------------------------------------------------------------------------------
@ -164,7 +164,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,8 +175,8 @@ contains !**********************************************************************
TPTCheckIntersection = 0
end function TPTCheckIntersection !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
integer(c_int) 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
!-------------------------------------------------------------------------------------------
@ -222,16 +223,16 @@ contains !**********************************************************************
! Tubular potential
!---------------------------------------------------------------------------------------------------
integer(c_int) function TPTPointPotential ( Q, U, F, R, S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the potential U and force F applied to the atom in position R and
integer(c_int) function TPTPointPotential ( Q, U, F, R, S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This function returns the potential U and force F applied to an 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
type(TPTSEG), intent(in) :: S
type(TPTSEG), intent(in) :: S
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, j
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
@ -277,16 +278,16 @@ 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(c_int) 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
type(TPTSEG), intent(in) :: S, Ssource
integer(c_int), intent(in) :: i
type(TPTSEG), intent(in) :: S, Ssource
integer(c_int), intent(in) :: i
!-------------------------------------------------------------------------------------------
integer(c_int) :: j
integer(c_int) :: j
real(c_double), dimension(0:2) :: R, Fp, Mp, Lrad
real(c_double) :: Qp, Up, Eps
real(c_double) :: Coeff
@ -319,7 +320,7 @@ contains !**********************************************************************
M = M * Coeff
end function TPTSectionPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPTSegmentPotential ( Q, U, F, M, S, Ssource ) !!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) 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.
!-------------------------------------------------------------------------------------------
@ -380,7 +381,7 @@ contains !**********************************************************************
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.
! 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