jianmu
/
lammps
forked from lijiext/lammps
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

update

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
cmake/CMakeLists.txt
View File

@ -452,6 +452,27 @@ foreach(SIMPLE_LIB POEMS USER-ATC USER-AWPMD USER-H5MD)
endif()
endforeach()
if(PKG_USER-MESONT)
enable_language(Fortran)
string(REGEX REPLACE "^USER-" "" PKG_LIB "USER-MESONT")
string(TOLOWER "${PKG_LIB}" PKG_LIB)
file(GLOB_RECURSE ${PKG_LIB}_SOURCES
${LAMMPS_LIB_SOURCE_DIR}/${PKG_LIB}/[^.]*.f90)
add_library(${PKG_LIB} STATIC ${${PKG_LIB}_SOURCES})
list(APPEND LAMMPS_LINK_LIBS ${PKG_LIB})
target_include_directories(${PKG_LIB} PUBLIC ${LAMMPS_LIB_SOURCE_DIR}/${PKG_LIB})
#include(Packages/USER-MESONT)
#list(APPEND DEFAULT_PACKAGES "USER-MESONT")
set(USER-MESONT_SOURCES_DIR ${LAMMPS_SOURCE_DIR}/USER-MESONT)
file(GLOB USER-MESONT_SOURCES ${USER-MESONT_SOURCES_DIR}/[^.]*.cpp)
file(GLOB USER-MESONT_HEADERS ${USER-MESONT_SOURCES_DIR}/[^.]*.h)
DetectBuildSystemConflict(${LAMMPS_SOURCE_DIR} ${USER-MESONT_SOURCES} ${USER-MESONT_HEADERS})
RegisterStyles(${USER-MESONT_SOURCES_DIR})
list(APPEND LIB_SOURCES ${USER-MESONT_SOURCES})
include_directories(${USER-MESONT_SOURCES_DIR})
endif()
if(PKG_USER-AWPMD)
target_link_libraries(awpmd ${LAPACK_LIBRARIES})
endif()

27
doc/src/compute_mesont.rst
View File

@ -13,7 +13,7 @@ Syntax
* ID, group-ID are documented in :doc:`compute <compute>` command
* mesont = style name of the compute command
* mode = one of estretch, ebend, etube, stretch_tot, ebend_tot, and etube_tot (see details below)
* mode = one of estretch, ebend, etube (see details below)
Examples
""""""""
@ -26,22 +26,19 @@ Examples
Description
"""""""""""
These computes define computations for the per-node stretching (estretch),
bending (ebend), and intertube (etube) energies, as well as the total
stretching (estretch_tot), bending (ebend_tot), and intertube (etube_tot)
energies for each atom (node) in a group. The evaluated value is selected by
a parameter passed to the compute: estretch, ebend, etube, estretch_tot,
ebend_tot, and etube_tot.
These computes define computations for the stretching (estretch), bending
(ebend), and intertube (etube) per-node (atom) and total energies. The
evaluated value is selected by a parameter passed to the compute: estretch,
ebend, etube.
**Output info:**
These computes calculate per-node (per-atom) vectors (estretch, ebend, etube),
which can be accessed by any command that uses per-atom values from a
compute as input, and global scalars (stretch_tot, ebend_tot, and etube_tot).
See the :doc:`Howto output <Howto_output>` doc page for an overview of LAMMPS
output options.
These computes calculate per-node (per-atom) vectors, which can be accessed by
any command that uses per-atom values from a compute as input, and global
scalars. See the :doc:`Howto output <Howto_output>` doc page for an overview of
LAMMPS output options.
The per-atom vector values will be in energy :doc:`units <units>`.
The computed values are provided in energy :doc:`units <units>`.
Restrictions
""""""""""""
@ -57,7 +54,3 @@ Related commands
**Default:** none
.. _lws: http://lammps.sandia.gov
.. _ld: Manual.html
.. _lc: Commands_all.html

71
doc/src/pair_mesont_tpm.rst
View File

@ -12,9 +12,9 @@ Syntax
pair_style mesont/tpm cut table_path BendingMode TPMType
* cut = the cutoff distance
* table_path = the path to the potential table, the default value is ./
* BendingMode = the parameter defining the type of the bending potential for nanotubes: 0 - harmonic bending :ref:`[1] <Srivastava>`, 1 - anharmonic potential of bending and bending-buckling :ref:`[2] <Zhigilei1>`
* TPMType = the parameter determining the type of the inter-tube interaction term: 0 - segment-segment approach, 1 - segment-chain approach :ref:`[3 <Zhigilei2>`, :ref:`4] <Zhigilei3>`
* table_path = the path to the potential table
* BendingMode = the parameter defining the type of the bending potential for nanotubes: 0 - harmonic bending :ref:`(Srivastava) <Srivastava>`, 1 - anharmonic potential of bending and bending-buckling :ref:`(Zhigilei1) <Zhigilei1>`
* TPMType = the parameter determining the type of the inter-tube interaction term: 0 - segment-segment approach, 1 - segment-chain approach :ref:`(Zhigilei2 <Zhigilei2>`, :ref:`Zhigilei3) <Zhigilei3>`
The segment-segment approach is approximately 5 times slower than segment-chain approximation.
The parameter BendingMode also affects the calculation of the inter-tube interaction term when TPMType = 1. In this case, when BendingMode = 1, each continuous chain of segments is additionally replaced by a number of sub-chains divided by bending buckling kinks.
@ -25,14 +25,14 @@ Examples
.. parsed-literal::
pair_style mesont/tpm 25.0 ./ 0 0
pair_style mesont/tpm 30.0 MESONT-TABTP_10_10.xrs 0 0
Description
"""""""""""
The tubular potential model (TPM) force field is designed for mesoscopic
simulations of interacting flexible nanotubes. The force field is based on the
mesoscopic computational model suggested in Ref. :ref:`[1] <Srivastava>`.
mesoscopic computational model suggested in Ref. :ref:`(Srivastava) <Srivastava>`.
In this model, each nanotube is represented by a chain of mesoscopic elements
in the form of stretchable cylindrical segments, where each segment consists
of multiple atoms. Each nanotube is divided into segments by a sequence of
@ -49,19 +49,19 @@ energy of the system:
U = U_{str} + U_{bnd} + U_{vdW}
where :math:`U_{str}` is the harmonic potential describing the stretching of nanotube
:ref:`[1] <Srivastava>`, :math:`U_{bnd}` is the potential for nanotube bending
:ref:`[1] <Srivastava>` and bending-buckling :ref:`[2] <Zhigilei1>`, and
:ref:`(Srivastava) <Srivastava>`, :math:`U_{bnd}` is the potential for nanotube bending
:ref:`(Srivastava) <Srivastava>` and bending-buckling :ref:`(Zhigilei1) <Zhigilei1>`, and
:math:`U_{vdW}` is the potential describing van-der Waals interaction between nanotubes
:ref:`[3 <Zhigilei2>`, :ref:`4] <Zhigilei3>`. The stretching energy, :math:`U_{str}` ,
:ref:`(Zhigilei2 <Zhigilei2>`, :ref:`Zhigilei3) <Zhigilei3>`. The stretching energy, :math:`U_{str}` ,
is given by the sum of stretching energies of individual nanotube segments.
The bending energy, :math:`U_{bnd}` , is given by the sum of bending energies in all
internal nanotube nodes. The tube-tube interaction energy, :math:`U_{vdW}` , is calculated
based on the tubular potential method suggested in Ref. :ref:`[3] <Zhigilei2>`.
based on the tubular potential method suggested in Ref. :ref:`(Zhigilei2) <Zhigilei2>`.
The tubular potential method is briefly described below.
The interaction between two straight nanotubes of arbitrary length and
orientation is described by the approximate tubular potential developed in
:ref:`[4] <Zhigilei3>`. This potential approximates the results of direct
:ref:`(Zhigilei3) <Zhigilei3>`. This potential approximates the results of direct
integration of carbon-carbon interatomic potential over the surfaces of the
interacting nanotubes, with the force sources homogeneously distributed over
the nanotube surfaces. The input data for calculation of tubular potentials
@ -69,7 +69,7 @@ are partially tabulated. For single-walled CNTs of arbitrary chirality, the
tabulated potential data can be generated in the form of ASCII files
TPMSSTP.xrs and TPMA.xrs by the stand-alone code TMDPotGen included in the
tool directory of LAMMPS release. The potential provided with LAMMPS release,
CNT\_10\_10, is tabulated for (10,10) nanotubes.
MESONT-TABTP_10_10.xrs, is tabulated for (10,10) nanotubes.
Calculations of the interaction between curved or bent nanotubes are performed
on either segment-segment or segment-chain basis. In the first case, activated
@ -88,7 +88,7 @@ the segment-chain approach. In this case, for each NT segment, the list of its
neighboring segments is divided into short continuous chains of segments
belonging to individual nanotubes. For each pair of a segment and a chain, the
curved chain is approximated by a straight equivalent nanotube based on the
weighted approach suggested in Ref. :ref:`[3] <Zhigilei2>`. Finally, the
weighted approach suggested in Ref. :ref:`(Zhigilei2) <Zhigilei2>`. Finally, the
interaction between the segment and straight equivalent chain is calculated
based on the tubular potential. In this case, and in the absence of bending
buckling (i.e., when parameter BendingMode is equal to 0), the tubular
@ -96,7 +96,7 @@ potential method ensures the absence of corrugation of the effective inter-tube
interaction potential for curved nanotubes and eliminates any barriers for the
inter-tube sliding. As a result, the tubular potential method can describe the
spontaneous self-assembly of nanotubes into continuous networks of bundles
:ref:`[2 <Zhigilei1>`, :ref:`4] <Zhigilei3>`.
:ref:`(Zhigilei1 <Zhigilei1>`, :ref:`Zhigilei3) <Zhigilei3>`.
----------
@ -106,15 +106,17 @@ The TMD force field has been used for generation of nanotube films, fibers,
and vertically aligned forests of nanotubes. Mesoscopic dynamic simulations
were used to prepare realistic structures of continuous networks of nanotube
bundles and to study their structural and mechanical properties
:ref:`[2 <Zhigilei1>`, :ref:`4 <Zhigilei3>` - :ref:`7] <Zhigilei6>`. With
:ref:`(Zhigilei1 <Zhigilei1>`, :ref:`Zhigilei3 <Zhigilei3>`, :ref:`Zhigilei4 <Zhigilei4>`,
:ref:`Zhigilei5 <Zhigilei5>`, :ref:`Zhigilei6) <Zhigilei6>`. With
additional models for heat transfer, this force filed was also used to
study the thermal transport properties of carbon nanotube films
:ref:`[8 <Zhigilei7>` - :ref:`10] <Zhigilei9>`. The methods for modeling of
:ref:`(Zhigilei7 <Zhigilei7>`, :ref:`Zhigilei8 <Zhigilei8>`, :ref:`Zhigilei8) <Zhigilei8>`.
The methods for modeling of
the mechanical energy dissipation into heat (energy exchange between the
dynamic degrees of freedom of the mesoscopic model and the energy of atomic
vibrations that are not explicitly represented in the model)
:ref:`[11] <Zhigilei10>` and mesoscopic description of covalent cross-links
between nanotubes :ref:`[12] <Banna>` have also been developed but are not
:ref:`(Zhigilei10) <Zhigilei10>` and mesoscopic description of covalent cross-links
between nanotubes :ref:`(Banna) <Banna>` have also been developed but are not
included in this first release of the LAMMPS implementation of the force field.
Further details can be found in references provided below.
@ -142,10 +144,11 @@ pair interactions.
The cutoff distance should be set to be at least :math:`max\left[2L,\sqrt{L^2/2+(2R+T_{cut})^2}\right]` ,
where L is the maximum segment length, R is the maximum tube radius, and
:math:`T_{cut}` = 10.2 A is the maximum distance between the surfaces of interacting
segments.
segments. Because of the use of extended chain concept at CNT ends, the recommended
cutoff is 3L.
The TPMSSTP.xrs and TPMA.xrs potential files provided with LAMMPS (see the
potentials directory) are parameterized for metal :doc:`units <units>`.
The MESONT-TABTP_10_10.xrs potential file provided with LAMMPS (see the
potentials directory) is parameterized for metal :doc:`units <units>`.
You can use the carbon nanotube mesoscopic force field with any LAMMPS units,
but you would need to create your own TPMSSTP.xrs and TPMA.xrs potential files
with coefficients listed in appropriate units, if your simulation
@ -163,53 +166,49 @@ Related commands
.. _Srivastava:
**[1]** Zhigilei, Wei, Srivastava, Phys. Rev. B 71, 165417 (2005).
**(Srivastava)** Zhigilei, Wei, Srivastava, Phys. Rev. B 71, 165417 (2005).
.. _Zhigilei1:
**[2]** Volkov and Zhigilei, ACS Nano 4, 6187 (2010).
**(Zhigilei1)** Volkov and Zhigilei, ACS Nano 4, 6187 (2010).
.. _Zhigilei2:
**[3]** Volkov, Simov, Zhigilei, ASME paper IMECE2008, 68021 (2008).
**(Zhigilei2)** Volkov, Simov, Zhigilei, ASME paper IMECE2008, 68021 (2008).
.. _Zhigilei3:
**[4]** Volkov, Zhigilei, J. Phys. Chem. C 114, 5513 (2010).
**(Zhigilei3)** Volkov, Zhigilei, J. Phys. Chem. C 114, 5513 (2010).
.. _Zhigilei4:
**[5]** Wittmaack, Banna, Volkov, Zhigilei, Carbon 130, 69 (2018).
**(Zhigilei4)** Wittmaack, Banna, Volkov, Zhigilei, Carbon 130, 69 (2018).
.. _Zhigilei5:
**[6]** Wittmaack, Volkov, Zhigilei, Compos. Sci. Technol. 166, 66 (2018).
**(Zhigilei5)** Wittmaack, Volkov, Zhigilei, Compos. Sci. Technol. 166, 66 (2018).
.. _Zhigilei6:
**[7]** Wittmaack, Volkov, Zhigilei, Carbon 143, 587 (2019).
**(Zhigilei6)** Wittmaack, Volkov, Zhigilei, Carbon 143, 587 (2019).
.. _Zhigilei7:
**[8]** Volkov, Zhigilei, Phys. Rev. Lett. 104, 215902 (2010).
**(Zhigilei7)** Volkov, Zhigilei, Phys. Rev. Lett. 104, 215902 (2010).
.. _Zhigilei8:
**[9]** Volkov, Shiga, Nicholson, Shiomi, Zhigilei, J. Appl. Phys. 111, 053501 (2012).
**(Zhigilei8)** Volkov, Shiga, Nicholson, Shiomi, Zhigilei, J. Appl. Phys. 111, 053501 (2012).
.. _Zhigilei9:
**[10]** Volkov, Zhigilei, Appl. Phys. Lett. 101, 043113 (2012).
**(Zhigilei9)** Volkov, Zhigilei, Appl. Phys. Lett. 101, 043113 (2012).
.. _Zhigilei10:
**[11]** Jacobs, Nicholson, Zemer, Volkov, Zhigilei, Phys. Rev. B 86, 165414 (2012).
**(Zhigilei10)** Jacobs, Nicholson, Zemer, Volkov, Zhigilei, Phys. Rev. B 86, 165414 (2012).
.. _Banna:
**[12]** Volkov, Banna, Comp. Mater. Sci. 176, 109410 (2020).
**(Banna)** Volkov, Banna, Comp. Mater. Sci. 176, 109410 (2020).
.. _lws: http://lammps.sandia.gov
.. _ld: Manual.html
.. _lc: Commands_all.html

1
examples/USER/mesont/README
View File

@ -11,4 +11,3 @@ Contributing author: Maxim Shugaev (UVA), mvs9t@virginia.edu
"film" is an example with a film composed of 396 200-nm-long
nanotubes (79596 nodes).

10
examples/USER/mesont/in.bundle
View File

@ -1,3 +1,4 @@
processors 1 1 *
newton on
units metal
lattice sc 1.0
@ -7,7 +8,7 @@ neigh_modify every 5 delay 0 check yes
atom_style mesont
# cut, path, BendingMode, TPMType
pair_style mesont/tpm 45.0 ../../../potentials/CNT_10_10 0 0
pair_style mesont/tpm 45.0 ../../../potentials/MESONT-TABTP_10_10.xrs 0 0
read_data data.bundle
pair_coeff * *
@ -22,11 +23,8 @@ compute Es all mesont estretch
compute Eb all mesont ebend
compute Et all mesont etube
compute B all property/atom buckling
compute Es_tot all mesont estretch_tot
compute Eb_tot all mesont ebend_tot
compute Et_tot all mesont etube_tot
thermo_style custom step time temp etotal ke pe c_Es_tot c_Eb_tot c_Et_tot
thermo_style custom step time temp etotal ke pe c_Es c_Eb c_Et
#dump out_dump all custom 50 dump.bundle id type x y z c_Es c_Eb c_Et c_B ix iy iz
run 100
run 100

9
examples/USER/mesont/in.film
View File

@ -7,7 +7,7 @@ neigh_modify every 5 delay 0 check yes
atom_style mesont
# cut, path, BendingMode, TPMType
pair_style mesont/tpm 25.0 ../../../potentials/CNT_10_10 1 0
pair_style mesont/tpm 30.0 ../../../potentials/MESONT-TABTP_10_10.xrs 1 0
read_data data.film
pair_coeff * *
@ -22,11 +22,8 @@ compute Es all mesont estretch
compute Eb all mesont ebend
compute Et all mesont etube
compute B all property/atom buckling
compute Es_tot all mesont estretch_tot
compute Eb_tot all mesont ebend_tot
compute Et_tot all mesont etube_tot
thermo_style custom step time temp etotal ke pe c_Es_tot c_Eb_tot c_Et_tot
thermo_style custom step time temp etotal ke pe c_Es c_Eb c_Et
#dump out_dump all custom 10 dump.film id type x y z c_Es c_Eb c_Et c_B ix iy iz
run 10
run 10

31
examples/USER/mesont/log.3Mar2020.bundle.g++.1
View File

@ -1,4 +1,6 @@
LAMMPS (3 Mar 2020)
using 1 OpenMP thread(s) per MPI task
processors 1 1 *
newton on
units metal
lattice sc 1.0
@ -9,13 +11,13 @@ neigh_modify every 5 delay 0 check yes
atom_style mesont
# cut, path, BendingMode, TPMType
pair_style mesont/tpm 45.0 ../../../potentials/CNT_10_10 0 0
pair_style mesont/tpm 45.0 ../../../potentials/MESONT-TABTP_10_10.xrs 0 0
read_data data.bundle
orthogonal box = (-143.89 -143.89 0) to (143.89 143.89 220)
1 by 1 by 1 MPI processor grid
reading atoms ...
77 atoms
read_data CPU = 0.442627 secs
read_data CPU = 0.025475 secs
pair_coeff * *
velocity all create 6000.0 2019
@ -29,11 +31,8 @@ compute Es all mesont estretch
compute Eb all mesont ebend
compute Et all mesont etube
compute B all property/atom buckling
compute Es_tot all mesont estretch_tot
compute Eb_tot all mesont ebend_tot
compute Et_tot all mesont etube_tot
thermo_style custom step time temp etotal ke pe c_Es_tot c_Eb_tot c_Et_tot
thermo_style custom step time temp etotal ke pe c_Es c_Eb c_Et
WARNING: New thermo_style command, previous thermo_modify settings will be lost (../output.cpp:708)
#dump out_dump all custom 50 dump.bundle id type x y z c_Es c_Eb c_Et c_B ix iy iz
@ -51,7 +50,7 @@ Neighbor list info ...
stencil: full/ghost/bin/3d
bin: standard
Per MPI rank memory allocation (min/avg/max) = 4.675 | 4.675 | 4.675 Mbytes
Step Time Temp TotEng KinEng PotEng c_Es_tot c_Eb_tot c_Et_tot
Step Time Temp TotEng KinEng PotEng c_Es c_Eb c_Et
0 0 6000 -201.86935 58.942626 -260.81198 0 0 -260.81198
10 0.05 5114.1875 -201.86234 50.240607 -252.10295 4.8334861 2.3998206 -259.33626
20 0.1 3437.2958 -201.8522 33.767207 -235.61941 11.42384 8.3426957 -255.38594
@ -63,20 +62,20 @@ Step Time Temp TotEng KinEng PotEng c_Es_tot c_Eb_tot c_Et_tot
80 0.4 3849.9855 -201.8635 37.821376 -239.68487 7.9899173 6.4332848 -254.10807
90 0.45 3618.1311 -201.85967 35.543692 -237.40336 9.2616931 7.0452637 -253.71032
100 0.5 2866.2722 -201.85273 28.157602 -230.01033 12.204916 10.284525 -252.49977
Loop time of 0.455531 on 1 procs for 100 steps with 77 atoms
Loop time of 0.457417 on 1 procs for 100 steps with 77 atoms
Performance: 94.834 ns/day, 0.253 hours/ns, 219.524 timesteps/s
99.7% CPU use with 1 MPI tasks x no OpenMP threads
Performance: 94.443 ns/day, 0.254 hours/ns, 218.619 timesteps/s
99.6% CPU use with 1 MPI tasks x 1 OpenMP threads
MPI task timing breakdown:
Section | min time | avg time | max time |%varavg| %total
---------------------------------------------------------------
Pair | 0.4551 | 0.4551 | 0.4551 | 0.0 | 99.91
Neigh | 6.485e-05 | 6.485e-05 | 6.485e-05 | 0.0 | 0.01
Comm | 3.0994e-05 | 3.0994e-05 | 3.0994e-05 | 0.0 | 0.01
Output | 0.00020385 | 0.00020385 | 0.00020385 | 0.0 | 0.04
Modify | 8.6069e-05 | 8.6069e-05 | 8.6069e-05 | 0.0 | 0.02
Other | | 4.697e-05 | | | 0.01
Pair | 0.45698 | 0.45698 | 0.45698 | 0.0 | 99.90
Neigh | 5.6982e-05 | 5.6982e-05 | 5.6982e-05 | 0.0 | 0.01
Comm | 4.4584e-05 | 4.4584e-05 | 4.4584e-05 | 0.0 | 0.01
Output | 0.00019693 | 0.00019693 | 0.00019693 | 0.0 | 0.04
Modify | 7.4863e-05 | 7.4863e-05 | 7.4863e-05 | 0.0 | 0.02
Other | | 6.318e-05 | | | 0.01
Nlocal: 77 ave 77 max 77 min
Histogram: 1 0 0 0 0 0 0 0 0 0

50
examples/USER/mesont/log.3Mar2020.film.g++.1
View File

@ -1,4 +1,5 @@
LAMMPS (3 Mar 2020)
using 1 OpenMP thread(s) per MPI task
newton on
units metal
lattice sc 1.0
@ -9,13 +10,13 @@ neigh_modify every 5 delay 0 check yes
atom_style mesont
# cut, path, BendingMode, TPMType
pair_style mesont/tpm 25.0 ../../../potentials/CNT_10_10 1 0
pair_style mesont/tpm 30.0 ../../../potentials/MESONT-TABTP_10_10.xrs 1 0
read_data data.film
orthogonal box = (-2500 -2500 -300) to (2500 2500 402.42)
1 by 1 by 1 MPI processor grid
reading atoms ...
79596 atoms
read_data CPU = 0.0903821 secs
read_data CPU = 0.110827 secs
pair_coeff * *
velocity all create 600.0 2019
@ -29,11 +30,8 @@ compute Es all mesont estretch
compute Eb all mesont ebend
compute Et all mesont etube
compute B all property/atom buckling
compute Es_tot all mesont estretch_tot
compute Eb_tot all mesont ebend_tot
compute Et_tot all mesont etube_tot
thermo_style custom step time temp etotal ke pe c_Es_tot c_Eb_tot c_Et_tot
thermo_style custom step time temp etotal ke pe c_Es c_Eb c_Et
WARNING: New thermo_style command, previous thermo_modify settings will be lost (../output.cpp:708)
#dump out_dump all custom 10 dump.film id type x y z c_Es c_Eb c_Et c_B ix iy iz
@ -41,45 +39,45 @@ run 10
Neighbor list info ...
update every 5 steps, delay 0 steps, check yes
max neighbors/atom: 2000, page size: 100000
master list distance cutoff = 26
ghost atom cutoff = 26
binsize = 13, bins = 385 385 31
master list distance cutoff = 31
ghost atom cutoff = 31
binsize = 15.5, bins = 323 323 26
1 neighbor lists, perpetual/occasional/extra = 1 0 0
(1) pair mesont/tpm, perpetual
attributes: full, newton on, ghost
pair build: full/bin/ghost
stencil: full/ghost/bin/3d
bin: standard
Per MPI rank memory allocation (min/avg/max) = 44.83 | 44.83 | 44.83 Mbytes
Step Time Temp TotEng KinEng PotEng c_Es_tot c_Eb_tot c_Et_tot
0 0 600 1347.2177 6173.0767 -4825.859 28.669574 21.29406 -4875.8226
10 0.1 389.40755 1373.7883 4006.4045 -2632.6161 848.00269 1404.4323 -4885.0511
Loop time of 4.21003 on 1 procs for 10 steps with 79596 atoms
Per MPI rank memory allocation (min/avg/max) = 37.43 | 37.43 | 37.43 Mbytes
Step Time Temp TotEng KinEng PotEng c_Es c_Eb c_Et
0 0 600 1347.2158 6173.0767 -4825.8609 28.669574 21.29406 -4875.8245
10 0.1 389.40755 1373.7864 4006.4045 -2632.6181 848.00267 1404.4323 -4885.053
Loop time of 5.41853 on 1 procs for 10 steps with 79596 atoms
Performance: 2.052 ns/day, 11.695 hours/ns, 2.375 timesteps/s
97.8% CPU use with 1 MPI tasks x no OpenMP threads
Performance: 1.595 ns/day, 15.051 hours/ns, 1.846 timesteps/s
97.7% CPU use with 1 MPI tasks x 1 OpenMP threads
MPI task timing breakdown:
Section | min time | avg time | max time |%varavg| %total
---------------------------------------------------------------
Pair | 4.1942 | 4.1942 | 4.1942 | 0.0 | 99.62
Pair | 5.4022 | 5.4022 | 5.4022 | 0.0 | 99.70
Neigh | 0 | 0 | 0 | 0.0 | 0.00
Comm | 0.00046039 | 0.00046039 | 0.00046039 | 0.0 | 0.01
Output | 0.00029182 | 0.00029182 | 0.00029182 | 0.0 | 0.01
Modify | 0.012385 | 0.012385 | 0.012385 | 0.0 | 0.29
Other | | 0.002726 | | | 0.06
Comm | 0.00052881 | 0.00052881 | 0.00052881 | 0.0 | 0.01
Output | 0.00029206 | 0.00029206 | 0.00029206 | 0.0 | 0.01
Modify | 0.012906 | 0.012906 | 0.012906 | 0.0 | 0.24
Other | | 0.002562 | | | 0.05
Nlocal: 79596 ave 79596 max 79596 min
Histogram: 1 0 0 0 0 0 0 0 0 0
Nghost: 1567 ave 1567 max 1567 min
Nghost: 1879 ave 1879 max 1879 min
Histogram: 1 0 0 0 0 0 0 0 0 0
Neighs: 0 ave 0 max 0 min
Histogram: 1 0 0 0 0 0 0 0 0 0
FullNghs: 412798 ave 412798 max 412798 min
FullNghs: 642270 ave 642270 max 642270 min
Histogram: 1 0 0 0 0 0 0 0 0 0
Total # of neighbors = 412798
Ave neighs/atom = 5.18617
Total # of neighbors = 642270
Ave neighs/atom = 8.06912
Neighbor list builds = 0
Dangerous builds = 0
Total wall time: 0:00:05
Total wall time: 0:00:07

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

21
potentials/CNT_10_10/TPMA.xrs
View File

@ -1,21 +0,0 @@
10 10 20
1.38310128694773
1.35724209149762
1.32365748767981
1.29442479067528
1.26718337154593
1.24958609494311
1.24451289818673
1.23708643487397
1.22995846566678
1.22360130756455
1.21805814607791
1.21324855249729
1.20903840855456
1.20526799643516
1.20171559451527
1.19823073480505
1.19488513621680
1.19171041995885
1.18871927412810
1.18605209171295

24
potentials/CNT_10_10/TPMSSTP.xrs → potentials/MESONT-TABTP_10_10.xrs
View File

@ -1,3 +1,6 @@
DATE 27-MAR-20
Tabulated data of the tubular potential for ( 10, 10) CNTs
A. N. Volkov, L. V. Zhigilei, J. Phys. Chem. C 114, 5513-5531, 2010. doi: 10.1021/jp906142h
10 10 1000 1000
0.00000000000000000E+00 0.00000000000000000E+00
-0.10557811324094224E-17 0.63808804195976917E-23
@ -696450,3 +696453,24 @@
0.00000000000000000E+00 0.00000000000000000E+00
0.00000000000000000E+00 0.00000000000000000E+00
0.00000000000000000E+00 0.00000000000000000E+00
10 10 20
1.38310128694773
1.35724209149762
1.32365748767981
1.29442479067528
1.26718337154593
1.24958609494311
1.24451289818673
1.23708643487397
1.22995846566678
1.22360130756455
1.21805814607791
1.21324855249729
1.20903840855456
1.20526799643516
1.20171559451527
1.19823073480505
1.19488513621680
1.19171041995885
1.18871927412810
1.18605209171295

2
src/Makefile
View File

@ -60,7 +60,7 @@ PACKAGE = asphere body class2 colloid compress coreshell dipole gpu \
PACKUSER = user-adios user-atc user-awpmd user-bocs user-cgdna user-cgsdk user-colvars \
user-diffraction user-dpd user-drude user-eff user-fep user-h5md \
user-intel user-lb user-manifold user-meamc user-meso \
user-intel user-lb user-manifold user-meamc user-mesodpd \
user-mgpt user-misc user-mofff user-molfile \
user-netcdf user-omp user-phonon user-plumed user-ptm user-qmmm \
user-qtb user-quip user-reaction user-reaxc user-scafacos user-smd user-smtbq \

7
src/USER-MESONT/README
View File

@ -30,14 +30,12 @@ pair_style mesont/tpm cut table_path BendingMode TPMType
be set to be at least max(2.0*L, sqrt(L^2/2 + (2.0*R + Tcut)^2)),
where L is the maximum segment length, R is the maximum tube radius,
and Tcut = 10.2 A is the maximum distance between surfaces of interacting
segments.
segments. However, the recommended cutoff is 3L.
compute mesont
This command allows evaluation of per atom and total values of stretching,
bending, and intertube interaction components of energies. Use the following
flags to obtain specific values: 'estretch' and 'estretch_tot' are per atom (node)
and total stretching energies, 'ebend' and 'ebend_tot' are per atom and total
bending energy, 'etube' and 'etube_tot' are per atom and total intertube energies
flags: 'estretch', 'ebend', 'etube'.
--
@ -89,4 +87,3 @@ modeling and mesoscopic description, Phys. Rev. B 86, 165414, 2012.
A. N. Volkov and A. H. Banna, Mesoscopic computational model of covalent
cross-links and mechanisms of load transfer in cross-linked carbon nanotube
films with continuous networks of bundles, Comp. Mater. Sci. 176, 109410, 2020.

29
src/USER-MESONT/compute_mesont.cpp
View File

@ -34,25 +34,18 @@ ComputeMesoNT::ComputeMesoNT(LAMMPS *lmp, int narg, char **arg) :
if (narg != 4) error->all(FLERR,"Illegal compute mesont command");
std::string ctype = arg[3];
if (ctype == "estretch") compute_type = ES;
else if (ctype == "estretch_tot") compute_type = ESTOT;
else if (ctype == "ebend") compute_type = EB;
else if (ctype == "ebend_tot") compute_type = EBTOT;
else if (ctype == "etube") compute_type = ET;
else if (ctype == "etube_tot") compute_type = ETTOT;
else error->all(FLERR,"Illegal compute mesont command");
if ((compute_type == ES) || (compute_type == EB) || (compute_type == ET)) {
peratom_flag = 1;
size_peratom_cols = 0;
peatomflag = 1;
timeflag = 1;
comm_reverse = 1;
nmax = 0;
} else {
timeflag = 1;
extscalar = 1;
scalar_flag = 1;
}
peratom_flag = 1;
size_peratom_cols = 0;
peatomflag = 1;
timeflag = 1;
comm_reverse = 1;
extscalar = 1;
scalar_flag = 1;
nmax = 0;
}
/* ---------------------------------------------------------------------- */
@ -70,11 +63,11 @@ double ComputeMesoNT::compute_scalar() {
int i;
double* ptr = NULL;
if (compute_type == ESTOT)
if (compute_type == ES)
ptr = static_cast<double*>(force->pair->extract("mesonttpm_Es_tot",i));
else if (compute_type == EBTOT)
else if (compute_type == EB)
ptr = static_cast<double*>(force->pair->extract("mesonttpm_Eb_tot",i));
else if (compute_type == ETTOT)
else if (compute_type == ET)
ptr = static_cast<double*>(force->pair->extract("mesonttpm_Et_tot",i));
else error->all(FLERR,"Illegal compute mesont command");

2
src/USER-MESONT/compute_mesont.h
View File

@ -41,7 +41,7 @@ class ComputeMesoNT : public Compute {
int nmax;
double *energy;
enum ComputeType {ES, EB, ET, ESTOT, EBTOT, ETTOT};
enum ComputeType {ES, EB, ET};
ComputeType compute_type;
};

3
src/USER-MESONT/export_mesont.h
View File

@ -19,8 +19,7 @@ extern "C" {
// see ExportCNT.f90 in lib/mesont for function details
void mesont_lib_TPBInit();
void mesont_lib_TPMInit(const int& M, const int& N);
void mesont_lib_SetTablePath(const char* TPMSSTPFile, const int& N1,
const char* TPMAFile, const int& N2);
void mesont_lib_SetTablePath(const char* TPMFile, const int& N);
void mesont_lib_InitCNTPotModule(const int& STRModel, const int& STRParams,
const int& YMType, const int& BNDModel, const double& Rref);

53
src/USER-MESONT/pair_mesont_tpm.cpp
View File

@ -585,19 +585,14 @@ void PairMESONTTPM::settings(int narg, char **arg){
for (j = i+1; j <= atom->ntypes; j++)
cut[i][j] = cut_global;
}
std::string TPMAFile;
if (narg > 1) {
std::string path = arg[1];
if(path.back() != '/') path += '/';
tab_path_length = path.length();
memory->create(tab_path,tab_path_length,"pair:path");
std::memcpy(tab_path, path.c_str(), tab_path_length);
std::string TPMSSTPFile = path + "TPMSSTP.xrs";
TPMAFile = path + "TPMA.xrs";
mesont_lib_SetTablePath(TPMSSTPFile.c_str(), TPMSSTPFile.length(),
TPMAFile.c_str(), TPMAFile.length());
}
else TPMAFile = "TPMA.xrs";
std::string TPMAFile = (narg > 1) ? arg[1] : "MESONT-TABTP.xrs";
tab_path_length = TPMAFile.length();
if (tab_path != NULL) memory->destroy(tab_path);
//c_str returns '\0' terminated string
memory->create(tab_path,tab_path_length+1,"pair:path");
std::memcpy(tab_path, TPMAFile.c_str(), tab_path_length+1);
mesont_lib_SetTablePath(tab_path, tab_path_length);
if (narg > 2) {
BendingMode = force->numeric(FLERR,arg[2]);
if ((BendingMode < 0) || (BendingMode > 1))
@ -613,6 +608,10 @@ void PairMESONTTPM::settings(int narg, char **arg){
int M, N;
std::ifstream in(TPMAFile);
if (!in.is_open()) error->all(FLERR,"Incorrect table path");
std::string tmp;
std::getline(in,tmp);
std::getline(in,tmp);
std::getline(in,tmp);
in >> M >> N;
in.close();
mesont_lib_TPMInit(M, N);
@ -709,7 +708,7 @@ void PairMESONTTPM::write_restart_settings(FILE *fp){
fwrite(&TPMType,sizeof(int),1,fp);
fwrite(&cut_global,sizeof(double),1,fp);
fwrite(&tab_path_length,sizeof(int),1,fp);
fwrite(tab_path,tab_path_length,1,fp);
fwrite(tab_path,tab_path_length+1,1,fp);
}
/* ----------------------------------------------------------------------
@ -729,23 +728,19 @@ void PairMESONTTPM::read_restart_settings(FILE *fp){
MPI_Bcast(&cut_global,1,MPI_DOUBLE,0,world);
MPI_Bcast(&tab_path_length,1,MPI_INT,0,world);
memory->create(tab_path,tab_path_length,"pair:path");
if (me == 0) fread(tab_path,tab_path_length,1,fp);
MPI_Bcast(tab_path,tab_path_length,MPI_CHAR,0,world);
if (tab_path != NULL) {
std::string TPMSSTPFile = std::string(tab_path) + "TPMSSTP.xrs";
std::string TPMAFile = std::string(tab_path) + "TPMA.xrs";
mesont_lib_SetTablePath(TPMSSTPFile.c_str(), TPMSSTPFile.length(),
TPMAFile.c_str(), TPMAFile.length());
}
std::string TPMAFile = std::string((tab_path == NULL) ? "" : tab_path)
+ "TPMA.xrs";
if (tab_path != NULL) memory->destroy(tab_path);
memory->create(tab_path,tab_path_length+1,"pair:path");
if (me == 0) fread(tab_path,tab_path_length+1,1,fp);
MPI_Bcast(tab_path,tab_path_length+1,MPI_CHAR,0,world);
mesont_lib_SetTablePath(tab_path,tab_path_length);
mesont_lib_TPBInit();
int M, N;
std::ifstream in(TPMAFile);
std::ifstream in(tab_path);
if (!in.is_open()) error->all(FLERR,"Incorrect table path");
std::string tmp;
std::getline(in,tmp);
std::getline(in,tmp);
std::getline(in,tmp);
in >> M >> N;
in.close();
mesont_lib_TPMInit(M, N);
@ -789,4 +784,4 @@ void* PairMESONTTPM::extract(const char *str, int &){
else if (strcmp(str,"mesonttpm_Eb") == 0) return eatom_b;
else if (strcmp(str,"mesonttpm_Et") == 0) return eatom_t;
else return NULL;
};
};

1
src/atom_vec.cpp
View File

@ -36,7 +36,6 @@ AtomVec::AtomVec(LAMMPS *lmp) : Pointers(lmp)
forceclearflag = 0;
size_data_bonus = 0;
maxexchange = 0;
molecular = 0;
kokkosable = 0;

734
tools/mesont/CNTPot.f90
View File

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

125
tools/mesont/ExportCNT.f90
View File

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

56
tools/mesont/Makefile.gfortran
View File

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

52
tools/mesont/Makefile.ifort
View File

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

5
tools/mesont/Makefile.lammps
View File

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

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

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

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

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

1
tools/mesont/Makefile.serial
View File

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

111
tools/mesont/README
View File

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -1,21 +1,6 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, Sandia National Laboratories
! Steve Plimpton, sjplimp@sandia.gov
!
! Copyright (2003) Sandia Corporation. Under the terms of Contract
! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
! certain rights in this software. This software is distributed under
! the GNU General Public License.
!
! See the README file in the top-level LAMMPS directory.
!
! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu
!-------------------------------------------------------------------------
module LinFun2 !************************************************************************************
!
! TMD Library: Bi-linear functions and their derivatives
! Bi-linear functions and their derivatives.
!
!---------------------------------------------------------------------------------------------------
!
@ -24,18 +9,18 @@ module LinFun2 !****************************************************************
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
real(c_double) function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P
real(c_double), dimension(0:N-1), intent(inout) :: F
integer(c_int) :: i1
real(c_double) :: A, A0
real*8 function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P
real*8, dimension(0:N-1), intent(inout) :: F
integer*4 :: i1
real*8 :: A, A0
!-------------------------------------------------------------------------------------------
i1 = i - 1
A0 = ( P(i) - X ) / ( P(i) - P(i1) )
@ -44,13 +29,13 @@ contains !**********************************************************************
end function CalcLinFun1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcLinFun1_1 ( S, Sx1, i, X, N, P, F, Fx ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: S, Sx1
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P
real(c_double), dimension(0:N-1), intent(inout) :: F, Fx
integer(c_int) :: i1
real(c_double) :: A, A0
real*8, intent(out) :: S, Sx1
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P
real*8, dimension(0:N-1), intent(inout) :: F, Fx
integer*4 :: i1
real*8 :: A, A0
!-------------------------------------------------------------------------------------------
i1 = i - 1
A0 = ( P(i) - X ) / ( P(i) - P(i1) )
@ -59,14 +44,14 @@ contains !**********************************************************************
Sx1 = A0 * Fx(i1) + A * Fx(i)
end subroutine CalcLinFun1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function CalcLinFun2_0 ( i, j, X, Y, N1, N2, P1, P2, F ) !!
integer(c_int), intent(in) :: i, j, N1, N2
real(c_double), intent(in) :: X, Y
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F
integer(c_int) :: i1, j1
real(c_double) :: A, A0, B, B0, G, G0
real*8 function CalcLinFun2_0 ( i, j, X, Y, N1, N2, P1, P2, F ) !!
integer*4, intent(in) :: i, j, N1, N2
real*8, intent(in) :: X, Y
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F
integer*4 :: i1, j1
real*8 :: A, A0, B, B0, G, G0
!-------------------------------------------------------------------------------------------
i1 = i - 1
j1 = j - 1
@ -80,14 +65,14 @@ contains !**********************************************************************
end function CalcLinFun2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcLinFun2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fx, Fy ) !!!!!!!!!!!!
real(c_double), intent(out) :: S, Sx1, Sy1
integer(c_int), intent(in) :: i, j, N1, N2
real(c_double), intent(in) :: X, Y
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fx, Fy
integer(c_int) :: i1, j1
real(c_double) :: A, A0, B, B0, G, G0
real*8, intent(out) :: S, Sx1, Sy1
integer*4, intent(in) :: i, j, N1, N2
real*8, intent(in) :: X, Y
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fx, Fy
integer*4 :: i1, j1
real*8 :: A, A0, B, B0, G, G0
!-------------------------------------------------------------------------------------------
i1 = i - 1
j1 = j - 1

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

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

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

@ -1,21 +1,6 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, Sandia National Laboratories
! Steve Plimpton, sjplimp@sandia.gov
!
! Copyright (2003) Sandia Corporation. Under the terms of Contract
! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
! certain rights in this software. This software is distributed under
! the GNU General Public License.
!
! See the README file in the top-level LAMMPS directory.
!
! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu
!-------------------------------------------------------------------------
module Spline1 !************************************************************************************
!
! TMD Library: One-dimensional cubic spline function
! One-dimensional cubic spline function.
!
!---------------------------------------------------------------------------------------------------
!
@ -24,25 +9,26 @@ module Spline1 !****************************************************************
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
real(c_double) function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!!!
real(c_double), intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1
real(c_double) :: H26, HL, HR
real*8 function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1
real*8 :: H26, HL, HR
!-------------------------------------------------------------------------------------------
H26 = Hi_1 * Hi_1 / 6.0
Hl = X - Xi_1
Hr = Xi - X
ValueSpline1_0 = ( ( Mi_1 * Hr * Hr * Hr + Mi * Hl * Hl * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * Hr + ( Yi - Mi * H26 ) * Hl ) / Hi_1
ValueSpline1_0 = ( ( Mi_1 * Hr * Hr * Hr + Mi * Hl * Hl * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * Hr &
+ ( Yi - Mi * H26 ) * Hl ) / Hi_1
end function ValueSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine ValueSpline1_1 ( S, S1, X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: S, S1
real(c_double), intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1
real(c_double) :: H6, H26, HL, HR, HL2, HR2
real*8, intent(out) :: S, S1
real*8, intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1
real*8 :: H6, H26, HL, HR, HL2, HR2
!-------------------------------------------------------------------------------------------
H6 = Hi_1 / 6.0d+00
H26 = Hi_1 * H6
@ -55,14 +41,11 @@ contains !**********************************************************************
end subroutine ValueSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine sprogonka3 ( N, K0, K1, K2, F, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! K0[i] * X[i-1] + K1[i] * X[I] + K2[i] * X[i+1] = F[i]
! i = 0..(N-1)
!-------------------------------------------------------------------------------------------
integer(c_int), intent(in) :: N
real(c_double), dimension(0:N-1), intent(in) :: K0, K1, K2
real(c_double), dimension(0:N-1), intent(inout) :: F, X
real(c_double) :: D
integer(c_int) :: i
integer*4, intent(in) :: N
real*8, dimension(0:N-1), intent(in) :: K0, K1, K2
real*8, dimension(0:N-1), intent(inout) :: F, X
real*8 :: D
integer*4 :: i
!-------------------------------------------------------------------------------------------
X(0) = F(0) / K1(0)
F(0) = - K2(0) / K1(0)
@ -77,11 +60,11 @@ contains !**********************************************************************
end subroutine sprogonka3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CreateSpline1 ( CL, CR, N, P, F, M, D, K0, K1, K2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: CL, CR, N
real(c_double), dimension (0:N-1), intent(in) :: P, F
real(c_double), dimension (0:N-1), intent(inout):: M, D, K0, K1, K2
integer(c_int) :: i
real(c_double) :: Z
integer*4, intent(in) :: CL, CR, N
real*8, dimension (0:N-1), intent(in) :: P, F
real*8, dimension (0:N-1), intent(inout):: M, D, K0, K1, K2
integer*4 :: i
real*8 :: Z
!-------------------------------------------------------------------------------------------
do i = 1, N - 1
K0(i) = P(i) - P(i-1)
@ -124,12 +107,12 @@ contains !**********************************************************************
call sprogonka3 ( N, K0, K1, K2, D, M )
end subroutine CreateSpline1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P, F, M
integer(c_int) :: j
real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
real*8 function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P, F, M
integer*4 :: j
real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
!-------------------------------------------------------------------------------------------
j = i - 1
HL = X - P(j)
@ -141,16 +124,17 @@ contains !**********************************************************************
HR2 = HR * HR
HLH = HL / H
HRH = HR / H
CalcSpline1_0 = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH
CalcSpline1_0 = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH &
+ ( F(i) - M(i) * H26 ) * HLH
end function CalcSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_1 ( S, S1, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: S, S1
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P, F, M
integer(c_int) :: j
real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
real*8, intent(out) :: S, S1
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P, F, M
integer*4 :: j
real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
!-------------------------------------------------------------------------------------------
j = i - 1
HL = X - P(j)
@ -167,12 +151,12 @@ contains !**********************************************************************
end subroutine CalcSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_2 ( S, S1, S2, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double), intent(out) :: S, S1, S2
integer(c_int), intent(in) :: i, N
real(c_double), intent(in) :: X
real(c_double), dimension(0:N-1), intent(in) :: P, F, M
integer(c_int) :: j
real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
real*8, intent(out) :: S, S1, S2
integer*4, intent(in) :: i, N
real*8, intent(in) :: X
real*8, dimension(0:N-1), intent(in) :: P, F, M
integer*4 :: j
real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH
!-------------------------------------------------------------------------------------------
j = i - 1
HL = X - P(j)
@ -190,3 +174,4 @@ contains !**********************************************************************
end subroutine CalcSpline1_2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module Spline1 !********************************************************************************

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

@ -1,21 +1,6 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, Sandia National Laboratories
! Steve Plimpton, sjplimp@sandia.gov
!
! Copyright (2003) Sandia Corporation. Under the terms of Contract
! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
! certain rights in this software. This software is distributed under
! the GNU General Public License.
!
! See the README file in the top-level LAMMPS directory.
!
! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu
!-------------------------------------------------------------------------
module Spline2 !************************************************************************************
!
! TMD Library: Two-dimensional cubic spline function
! Two-dimensional cubic spline function.
!
!---------------------------------------------------------------------------------------------------
!
@ -26,18 +11,18 @@ module Spline2 !****************************************************************
!***************************************************************************************************
use Spline1
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
subroutine CreateSpline2 ( CL, CD, CR, CU, N1, N2, N, P1, P2, F, Fxx, Fyy, Fxxyy, FF, MM, DD, K0, K1, K2 )
integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N2, N
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
real(c_double), dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2
integer(c_int) :: II
integer*4, intent(in) :: CL, CD, CR, CU, N1, N2, N
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
real*8, dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2
integer*4 :: II
!-------------------------------------------------------------------------------------------
do II = 0, N2 - 1
FF(0:N1-1) = F(0:N1-1,II)
@ -69,12 +54,12 @@ contains !**********************************************************************
end subroutine CreateSpline2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CreateSpline2Ext ( CL, CD, CR, CU, N1, N1A, N2, N2A, N, P1, P2, F, Fxx, Fyy, Fxxyy, FF, MM, DD, K0, K1, K2 )
integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N1A, N2, N2A, N
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
real(c_double), dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2
integer(c_int) :: II
integer*4, intent(in) :: CL, CD, CR, CU, N1, N1A, N2, N2A, N
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
real*8, dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2
integer*4 :: II
!-------------------------------------------------------------------------------------------
Fxx = 0.0d+00
Fyy = 0.0d+00
@ -142,14 +127,14 @@ contains !**********************************************************************
end subroutine CreateSpline2Ext !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real(c_double) function CalcSpline2_0 ( i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!!!!!!!!!
integer(c_int), intent(in) :: i, j, N1, N2
real(c_double), intent(in) :: X, Y
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
integer(c_int) :: i1, j1
real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
real*8 function CalcSpline2_0 ( i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!!!!!!!!!
integer*4, intent(in) :: i, j, N1, N2
real*8, intent(in) :: X, Y
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
integer*4 :: i1, j1
real*8 :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
!-------------------------------------------------------------------------------------------
i1 = i - 1
j1 = j - 1
@ -162,15 +147,15 @@ contains !**********************************************************************
end function CalcSpline2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!
real(c_double), intent(out) :: S, Sx1, Sy1
integer(c_int), intent(in) :: i, j, N1, N2
real(c_double), intent(in) :: X, Y
real(c_double), dimension(0:N1-1), intent(in) :: P1
real(c_double), dimension(0:N2-1), intent(in) :: P2
real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
integer(c_int) :: i1, j1
real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
real(c_double) :: Gyy_0, Gyy_1, Gxxyy_0, Gxxyy_1
real*8, intent(out) :: S, Sx1, Sy1
integer*4, intent(in) :: i, j, N1, N2
real*8, intent(in) :: X, Y
real*8, dimension(0:N1-1), intent(in) :: P1
real*8, dimension(0:N2-1), intent(in) :: P2
real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy
integer*4 :: i1, j1
real*8 :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1
real*8 :: Gyy_0, Gyy_1, Gxxyy_0, Gxxyy_1
!-------------------------------------------------------------------------------------------
i1 = i - 1
j1 = j - 1

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

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

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

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

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

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

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

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

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

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

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

File diff suppressed because it is too large Load Diff

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

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

290
tools/mesont/TPMForceField.f90
View File

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

195
tools/mesont/TPMM0.f90
View File

@ -1,195 +0,0 @@
! ------------ ----------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! http://lammps.sandia.gov, Sandia National Laboratories
! Steve Plimpton, sjplimp@sandia.gov
!
! Copyright (2003) Sandia Corporation. Under the terms of Contract
! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
! certain rights in this software. This software is distributed under
! the GNU General Public License.
!
! See the README file in the top-level LAMMPS directory.
!
! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu
!-------------------------------------------------------------------------
module TPMM0 !**************************************************************************************
!
! TMD Library: Combined/Weighted potential of type 0
!
! Direct application of SST potential to calculation of segment-segment interaction
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
!use TMDCounters
use TubePotMono
use iso_c_binding, only : c_int, c_double, c_char
implicit none
contains !******************************************************************************************
integer(c_int) function TPMInteractionFSS ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2, EType )
real(c_double), intent(inout) :: Q, U
real(c_double), dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2
real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2
integer(c_int), intent(in) :: EType
!-------------------------------------------------------------------------------------------
real(c_double) :: Qa, Ua, Fd, L2
real(c_double), dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a, R2_3, R2, Laxis2, F
integer(c_int) :: IntSign
!-------------------------------------------------------------------------------------------
! C_TPM_4 = C_TPM_4 + 1
R2 = 0.5d+00 * ( R2_1 + R2_2 )
Laxis2 = R2_2 - R2_1
L2 = S_V3norm3 ( Laxis2 )
Laxis2 = Laxis2 / L2
if ( EType < 2 ) then
TPMInteractionFSS = TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, 1 )
R2_3 = R2_2 + R2_2 - R2_1
IntSign = TPMInteractionF ( Qa, Ua, F1_1a, F1_2a, F2_1a, F2_2a, Fd, R1_1, R1_2, R2_2, R2_3, 1 )
if ( IntSign > 0 ) then
TPMInteractionFSS = 1
call TPMSegmentForces ( F2_1a, F2_2a, F1_1a, F1_2a, R1_1, R1_2, R2, Laxis2, L2 )
F = ( Fd - S_V3xV3 ( F2_2a, Laxis2 ) ) * Laxis2
F2_2a = F2_2a + F
F2_1a = F2_1a - F
end if
else
TPMInteractionFSS = TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, 2 )
R2_3 = R2_1 + R2_1 - R2_2
IntSign = TPMInteractionF ( Qa, Ua, F1_1a, F1_2a, F2_1a, F2_2a, Fd, R1_1, R1_2, R2_1, R2_3, 1 )
if ( IntSign > 0 ) then
TPMInteractionFSS = 1
call TPMSegmentForces ( F2_1a, F2_2a, F1_1a, F1_2a, R1_1, R1_2, R2, Laxis2, L2 )
F = ( - Fd - S_V3xV3 ( F2_1a, Laxis2 ) ) * Laxis2
F2_1a = F2_1a + F
F2_2a = F2_2a - F
end if
end if
if ( IntSign > 0 ) then
Q = Q - Qa
if ( Q < 0.0d+00 ) Q = 0.0d+00
U = U - Ua
F2_1 = F2_1 - F2_1a
F2_2 = F2_2 - F2_2a
F1_1 = F1_1 - F1_1a
F1_2 = F1_2 - F1_2a
end if
end function TPMInteractionFSS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer(c_int) function TPMInteractionFW0 ( QQ, U, U1, U2, UU, F1, F2, F, G1, G2, R1, R2, N, NMAX, R )
real(c_double), intent(inout) :: U, U1, U2
integer(c_int), intent(in) :: N, NMAX
real(c_double), dimension(0:NMAX-1), intent(out) :: QQ, UU
real(c_double), dimension(0:2), intent(out) :: F1, F2
real(c_double), dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2
real(c_double), dimension(0:2), intent(in) :: R1, R2
real(c_double), dimension(0:2,0:NMAX-1), intent(in) :: R
!-------------------------------------------------------------------------------------------
integer(c_int) :: i, SType2, GeomID, EType
real(c_double) :: Ua
real(c_double), dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a
real(c_double), dimension(0:2) :: R1a, R2a, Laxis1, Laxis2, L12, DR
real(c_double) :: L1, L2, D1, D2, H, cosA, D, Dmina, Dminb
!-------------------------------------------------------------------------------------------
QQ = 0.0d+00
U = 0.0d+00
U1 = 0.0d+00
U2 = 0.0d+00
UU = 0.0d+00
F1 = 0.0d+00
F2 = 0.0d+00
F = 0.0d+00
G1 = 0.0d+00
G2 = 0.0d+00
TPMInteractionFW0 = 0
do i = 0, N - 2
R1a = 0.5d+00 * ( R1 + R2 )
R2a = 0.5d+00 * ( R(0:2,i+1) + R(0:2,i) )
Laxis1 = R2 - R1
Laxis2 = R(0:2,i+1) - R(0:2,i)
L1 = S_V3norm3 ( Laxis1 )
L2 = S_V3norm3 ( Laxis2 )
Laxis1 = Laxis1 / L1
Laxis2 = Laxis2 / L2
L2 = 0.5d+00 * L2
L1 = 0.5d+00 * L1
GeomID = LineLine ( H, cosA, D1, D2, L12, R1a, Laxis1, R2a, Laxis2, TPGeomPrec )
DR = R1 - R(0:2,i)
call ApplyPeriodicBC ( DR )
Dmina = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
DR = R2 - R(0:2,i)
call ApplyPeriodicBC ( DR )
D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
if ( D < Dmina ) Dmina = D
if ( GeomID == MD_LINES_NONPAR ) then
D = ( D2 - L2 ) * cosA
if ( D > D1 - L1 .and. D < D1 + L1 ) then
D = sqr ( D2 - L2 ) * ( 1.0d+00 - sqr ( cosA ) ) + sqr ( H )
if ( D < Dmina ) Dmina = D
end if
else
call LinePoint ( D, DR, R1, Laxis1, R(0:2,i) )
if ( D > 0.0d+00 .and. D < 2.0d+00 * L1 ) then
DR = DR - R(0:2,i)
call ApplyPeriodicBC ( DR )
D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
if ( D < Dmina ) Dmina = D
end if
end if
DR = R1 - R(0:2,i+1)
call ApplyPeriodicBC ( DR )
Dminb = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
DR = R2 - R(0:2,i+1)
call ApplyPeriodicBC ( DR )
D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
if ( D < Dminb ) Dminb = D
if ( GeomID == MD_LINES_NONPAR ) then
D = ( D2 + L2 ) * cosA
if ( D > D1 - L1 .and. D < D1 + L1 ) then
D = sqr ( D2 + L2 ) * ( 1.0d+00 - sqr ( cosA ) ) + sqr ( H )
if ( D < Dminb ) Dminb = D
end if
else
call LinePoint ( D, DR, R1, Laxis1, R(0:2,i+1) )
if ( D > 0.0d+00 .and. D < 2.0d+00 * L1 ) then
DR = DR - R(0:2,i+1)
call ApplyPeriodicBC ( DR )
D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) )
if ( D < Dminb ) Dminb = D
end if
end if
if ( Dmina < Dminb ) then
EType = 1
else
EType = 2
end if
if ( TPMInteractionFSS ( QQ(i), Ua, F1_1a, F1_2a, F2_1a, F2_2a, R1, R2, R(0:2,i), R(0:2,i+1), EType ) > 0 ) then
TPMInteractionFW0 = 1
U = U + Ua
Ua = 0.25d+00 * Ua
U1 = U1 + Ua
U2 = U2 + Ua
UU(i) = UU(i) + Ua
UU(i+1) = UU(i+1) + Ua
F1 = F1 + F1_1a
F2 = F2 + F1_2a
F(0:2,i) = F(0:2,i) + F2_1a
F(0:2,i+1) = F(0:2,i+1) + F2_2a
G2(0:2,i) = F2_1a
G1(0:2,i+1) = F2_2a
end if
end do
end function TPMInteractionFW0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TPMM0 !**********************************************************************************

379
tools/mesont/TPMM1.f90
View File

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

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

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