CNT package

The tubular potential model (TPM) force field for Carbon Nanotubes (CNTs) package.
This commit is contained in:
iafoss 2020-02-06 16:50:38 -05:00
parent f0935feabe
commit 0204bf286b
79 changed files with 789926 additions and 0 deletions

View File

@ -39,6 +39,13 @@ KOKKOS, o = USER-OMP, t = OPT.
* :doc:`cluster/atom <compute_cluster_atom>`
* :doc:`cna/atom <compute_cna_atom>`
* :doc:`cnp/atom <compute_cnp_atom>`
* :doc:`cnt/Es <compute_cnt>`
* :doc:`cnt/Eb <compute_cnt>`
* :doc:`cnt/Et <compute_cnt>`
* :doc:`cnt/B <compute_cnt>`
* :doc:`cnt/Es_tot <compute_cnt>`
* :doc:`cnt/Eb_tot <compute_cnt>`
* :doc:`cnt/Et_tot <compute_cnt>`
* :doc:`com <compute_com>`
* :doc:`com/chunk <compute_com_chunk>`
* :doc:`contact/atom <compute_contact_atom>`
@ -163,3 +170,4 @@ KOKKOS, o = USER-OMP, t = OPT.
* :doc:`vcm/chunk <compute_vcm_chunk>`
* :doc:`voronoi/atom <compute_voronoi_atom>`
* :doc:`xrd <compute_xrd>`

View File

@ -60,6 +60,7 @@ OPT.
* :doc:`buck/mdf <pair_mdf>`
* :doc:`buck6d/coul/gauss/dsf <pair_buck6d_coul_gauss>`
* :doc:`buck6d/coul/gauss/long <pair_buck6d_coul_gauss>`
* :doc:`cnt/tpm <pair_cnt_tpm>`
* :doc:`colloid (go) <pair_colloid>`
* :doc:`comb (o) <pair_comb>`
* :doc:`comb3 <pair_comb>`

View File

@ -88,6 +88,8 @@ quantities.
+--------------+-----------------------------------------------------+--------------------------------------+
| *charge* | charge | atomic system with charges |
+--------------+-----------------------------------------------------+--------------------------------------+
| *cnt* | mass, radius, length, buckling, connections, tube id| Carbon nanotubes |
+--------------+-----------------------------------------------------+--------------------------------------+
| *dipole* | charge and dipole moment | system with dipolar particles |
+--------------+-----------------------------------------------------+--------------------------------------+
| *dpd* | internal temperature and internal energies | DPD particles |
@ -125,6 +127,7 @@ quantities.
| *wavepacket* | charge, spin, eradius, etag, cs\_re, cs\_im | AWPMD |
+--------------+-----------------------------------------------------+--------------------------------------+
.. note::
It is possible to add some attributes, such as a molecule ID, to
@ -220,6 +223,10 @@ For the *tri* style, the particles are planar triangles and each
stores a per-particle mass and size and orientation (i.e. the corner
points of the triangle).
For the *cnt* style, the particles represent nodes of Carbon Nanotube
segments, and each stores a per-particle mass, radius, segment
length, tube id, buckling flag, and connections with neighbor nodes.
The *template* style allows molecular topology (bonds,angles,etc) to be
defined via a molecule template using the :doc:`molecule <molecule>`
command. The template stores one or more molecules with a single copy
@ -351,6 +358,8 @@ The *spin* style is part of the SPIN package.
The *wavepacket* style is part of the USER-AWPMD package for the
:doc:`antisymmetrized wave packet MD method <pair_awpmd>`.
The *cnt* style is part of the USER-CNT package.
Related commands
""""""""""""""""

View File

@ -197,6 +197,13 @@ The individual style names on the :doc:`Commands compute <Commands_compute>` doc
* :doc:`cluster/atom <compute_cluster_atom>` - cluster ID for each atom
* :doc:`cna/atom <compute_cna_atom>` - common neighbor analysis (CNA) for each atom
* :doc:`cnp/atom <compute_cnp_atom>` - common neighborhood parameter (CNP) for each atom
* :doc:`cnt/Es <compute_cnt>` - Carbon Nanotube (CNT) stretching per node energy
* :doc:`cnt/Eb <compute_cnt>` - CNT bending per node energy
* :doc:`cnt/Et <compute_cnt>` - CNT intertube per node energy
* :doc:`cnt/B <compute_cnt>` - CNT per node buckling flag
* :doc:`cnt/Es_tot <compute_cnt>` - CNT stretching energy
* :doc:`cnt/Eb_tot <compute_cnt>` - CNT bending energy
* :doc:`cnt/Et_tot <compute_cnt>` - CNT intertube energy
* :doc:`com <compute_com>` - center-of-mass of group of atoms
* :doc:`com/chunk <compute_com_chunk>` - center-of-mass for each chunk
* :doc:`contact/atom <compute_contact_atom>` - contact count for each spherical particle
@ -332,3 +339,8 @@ Related commands
:doc:`uncompute <uncompute>`, :doc:`compute_modify <compute_modify>`, :doc:`fix ave/atom <fix_ave_atom>`, :doc:`fix ave/time <fix_ave_time>`, :doc:`fix ave/histo <fix_ave_histo>`
**Default:** none
.. _lws: http://lammps.sandia.gov
.. _ld: Manual.html
.. _lc: Commands_all.html

78
doc/src/compute_cnt.rst Normal file
View File

@ -0,0 +1,78 @@
.. index:: compute cnt
compute cnt/Es command
=======================
compute cnt/Eb command
=======================
compute cnt/Et command
=======================
compute cnt/B command
=======================
compute cnt/Es\_tot command
=======================
compute cnt/Eb\_tot command
=======================
compute cnt/Et\_tot command
=======================
Syntax
""""""
.. parsed-literal::
compute ID group-ID cnt/Es
* ID, group-ID are documented in :doc:`compute <compute>` command
* cnt/Es = style name of the compute command
Examples
""""""""
.. parsed-literal::
compute 1 all cnt/Es
Description
"""""""""""
These computes define computations for the per-node stretching (cnt/Es),
bending (cnt/Eb), and intertube (cnt/Et) energies, buckling flag (cnt/B),
as well as the total stretching (cnt/Es\_tot), bending (cnt/Eb\_tot), and
intertube (cnt/Et\_tot) energies for each atom (node) in a group.
**Output info:**
These computes calculate per-node (per-atom) vectors (cnt/Es, cnt/Eb, cnt/Et, cnt/B),
which can be accessed by any command that uses per-atom values from a
compute as input, and global scalars (cnt/Es\_tot, cnt/Eb\_tot,
cnt/Et\_tot). 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>`.
Restrictions
""""""""""""
These computes are part of the USER-CNT package. They are only enabled if
LAMMPS is built with that package. See the :doc:`Build package <Build_package>`
doc page for more info. In addition, :doc:`cnt pair_style <pair_style>`
must be used.
Related commands
""""""""""""""""
:doc:`dump custom <dump>`
**Default:** none
.. _lws: http://lammps.sandia.gov
.. _ld: Manual.html
.. _lc: Commands_all.html

245
doc/src/pair_cnt_tpm.rst Normal file
View File

@ -0,0 +1,245 @@
.. index:: pair\_style cnt/tpm
pair\_style cnt/tpm command
==========================
Syntax
""""""
.. parsed-literal::
pair_style cnt/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>`
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.
Examples
""""""""
.. parsed-literal::
pair_style cnt/tpm 25.0 ./ 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>`.
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 sequent of nodes
placed on the nanotube centerline. This sequence of nodes determines the
spatial position of the cylindrical segments and defines the configuration of
the entire tube.
The potential force field that controls the dynamic behavior of a system of
interacting nanotubes is given by the following equation defining the potential
energy of the system:
.. image:: Eqs/cnt_eq.jpg
:align: center
where U\_str is the harmonic potential describing the stretching of CNTs
:ref:`[1] <Srivastava>`, U\_bnd is the potential for nanotube bending
:ref:`[1] <Srivastava>` and bending-buckling :ref:`[2] <Zhigilei1>`, and
U\_vdW is the potential describing van-der Waals interaction between nanotubes
:ref:`[3 <Zhigilei2>`, :ref:`4] <Zhigilei3>`. The stretching energy, U\_str,
is given by the sum of stretching energies of individual nanotube segments.
The bending energy, U\_bnd, is given by the sum of bending energies in all
internal nanotube nodes. The tube-tube interaction energy, U\_vdW, is calculated
based on the tubular potential method suggested in Ref. :ref:`[3] <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
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
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.
Calculations of the interaction between curved or bent nanotubes are performed
on either segment-segment or segment-chain basis. In the first case, activated
when parameter TPMType is equal to 0, the tubular potential is calculated for
each pair of interacting mesoscopic segments. In this case, however, small
potential barriers for inter-tube sliding are introduced. While relatively
small, these barriers are still larger than the ones that originate from the
atomic-scale corrugation in atomistic modeling of inter-tube interaction. The
latter are too weak to prevent room-temperature rearrangements of defect-free
CNT, while the artificial mesoscopic barriers due to the segment-segment
interaction can impede sliding of nanotubes with respect to each other and
affect the kinetics of structural rearrangements in a system of nanotubes at
moderate mesoscopic temperatures. In the second case, activated when parameter
TPMType is equal to 1, the inter-tube interaction term is calculated based on
the segment-chain approach. In this case, for each CNT 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
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
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>`.
----------
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
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
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
included in this first release of the LAMMPS implementation of the force field.
Further details can be found in references provided below.
The CNT package also provides TMDGen code designed to generate initial samples
composed of straight and dispersed nanotubes of given chirality and length at a
given material density, which is availible in tools directory. 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 of coordinates. All parameters in the sample files generated with TMDGen
are given in metal :doc:`units <units>`.
Restrictions
""""""""""""
This pair style is a part of the USER-CNT package, and it is only enabled if
LAMMPS is built with that package. See the :doc:`Build package <Build_package>`
doc page for more information.
This pair potential requires use of :doc:`cnt atomic style <atom_style>`.
This pair potential requires the :doc:`newton <newton>` setting to be "on" for
pair interactions.
The cutoff distance should be set to be at least:
.. image:: Eqs/cnt_cut.jpg
:align: center
where L is the maximum segment length, R is the maximum tube radius, and
T_cut = 10.2 A is the maximum distance between the surfaces of interacting
segments.
The TPMSSTP.xrs and TPMA.xrs potential files provided with LAMMPS (see the
potentials directory) are 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
does not use "metal" units.
The chirality parameters set during system generation must match the values
specified during generation of the potential tables.
This pair style has not been developed to support :doc:`hybrid <pair_hybrid>`
pair style and has never been tested for this style.
Related commands
""""""""""""""""
:doc:`pair_coeff <pair_coeff>`
----------
.. _Srivastava:
**[1]** Zhigilei, Wei, Srivastava, Phys. Rev. B 71, 165417 (2005).
.. _Zhigilei1:
**[2]** Volkov and Zhigilei, ACS Nano 4, 6187 (2010).
.. _Zhigilei2:
**[3]** Volkov, Simov, Zhigilei, ASME paper IMECE2008, 68021 (2008).
.. _Zhigilei3:
**[4]** Volkov, Zhigilei, J. Phys. Chem. C 114, 5513 (2010).
.. _Zhigilei4:
**[5]** Wittmaack, Banna, Volkov, Zhigilei, Carbon 130, 69 (2018).
.. _Zhigilei5:
**[6]** Wittmaack, Volkov, Zhigilei, Compos. Sci. Technol. 166, 66 (2018).
.. _Zhigilei6:
**[7]** Wittmaack, Volkov, Zhigilei, Carbon 143, 587 (2019).
.. _Zhigilei7:
**[8]** Volkov, Zhigilei, Phys. Rev. Lett. 104, 215902 (2010).
.. _Zhigilei8:
**[9]** Volkov, Shiga, Nicholson, Shiomi, Zhigilei, J. Appl. Phys. 111, 053501 (2012).
.. _Zhigilei9:
**[10]** Volkov, Zhigilei, Appl. Phys. Lett. 101, 043113 (2012).
.. _Zhigilei10:
**[11]** Jacobs, Nicholson, Zemer, Volkov, Zhigilei, Phys. Rev. B 86, 165414 (2012).
.. _Banna:
**[12]** Volkov, Banna, Comp. Mater. Sci. 176, 109410 (2020).
.. _lws: http://lammps.sandia.gov
.. _ld: Manual.html
.. _lc: Commands_all.html

View File

@ -131,6 +131,7 @@ accelerated styles exist.
* :doc:`buck/mdf <pair_mdf>` - Buckingham with a taper function
* :doc:`buck6d/coul/gauss/dsf <pair_buck6d_coul_gauss>` - dispersion-damped Buckingham with damped-shift-force model
* :doc:`buck6d/coul/gauss/long <pair_buck6d_coul_gauss>` - dispersion-damped Buckingham with long-range Coulombics
* :doc:`cnt/tpm <pair_cnt_tpm>` - carbon nanotubes mesoscopic force field
* :doc:`colloid <pair_colloid>` - integrated colloidal potential
* :doc:`comb <pair_comb>` - charge-optimized many-body (COMB) potential
* :doc:`comb3 <pair_comb>` - charge-optimized many-body (COMB3) potential
@ -357,3 +358,8 @@ Default
.. parsed-literal::
pair_style none
.. _lws: http://lammps.sandia.gov
.. _ld: Manual.html
.. _lc: Commands_all.html

15
examples/USER/cnt/README Normal file
View File

@ -0,0 +1,15 @@
=== CNT examples ===
===============================
The files in this folder provide examples of using the CNT
mesoscopic force field (USER-CN).
Contributing author: Maxim Shugaev (UVA), mvs9t@virginia.edu
"bundle" is an example with a single bundle composed of 7 nanotubes.
"system" is an example with a film composed of 396 200-nm-long
nanotubes (79596 nodes).

View File

@ -0,0 +1,45 @@
newton on
log cnt.log
echo both
units metal
lattice sc 1.0
boundary fs fs p
neighbor 1.0 bin
neigh_modify every 5 delay 0 check yes
atom_style cnt
# cut, path, BendingMode, TPMType
pair_style cnt/tpm 45.0 ../../../potentials/CNT_10_10 0 0
read_data bundle.init
pair_coeff * *
velocity all create 6000.0 2019
timestep 0.005
fix 1 all nve
#fix 1 all nvt temp 3000.0 3000.0 1.0
thermo_modify flush yes
thermo 10
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.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 10000
write_data system.data

View File

@ -0,0 +1,93 @@
77 atoms
1 atom types
-143.89 143.89 xlo xhi
-143.89 143.89 ylo yhi
0 220 zlo zhi
Masses
1 1.0
Atoms
1 1 1 11 2 5860.43 6.785 20 0 0 0 0 0 0 0
2 1 1 1 3 5860.43 6.785 20 0 0 0 20 0 0 0
3 1 1 2 4 5860.43 6.785 20 0 0 0 40 0 0 0
4 1 1 3 5 5860.43 6.785 20 0 0 0 60 0 0 0
5 1 1 4 6 5860.43 6.785 20 0 0 0 80 0 0 0
6 1 1 5 7 5860.43 6.785 20 0 0 0 100 0 0 0
7 1 1 6 8 5860.43 6.785 20 0 0 0 120 0 0 0
8 1 1 7 9 5860.43 6.785 20 0 0 0 140 0 0 0
9 1 1 8 10 5860.43 6.785 20 0 0 0 160 0 0 0
10 1 1 9 11 5860.43 6.785 20 0 0 0 180 0 0 0
11 1 1 10 1 5860.43 6.785 20 0 0 0 200 0 0 0
12 2 1 22 13 5860.43 6.785 20 0 16.6992 0 0 0 0 0
13 2 1 12 14 5860.43 6.785 20 0 16.6992 0 20 0 0 0
14 2 1 13 15 5860.43 6.785 20 0 16.6992 0 40 0 0 0
15 2 1 14 16 5860.43 6.785 20 0 16.6992 0 60 0 0 0
16 2 1 15 17 5860.43 6.785 20 0 16.6992 0 80 0 0 0
17 2 1 16 18 5860.43 6.785 20 0 16.6992 0 100 0 0 0
18 2 1 17 19 5860.43 6.785 20 0 16.6992 0 120 0 0 0
19 2 1 18 20 5860.43 6.785 20 0 16.6992 0 140 0 0 0
20 2 1 19 21 5860.43 6.785 20 0 16.6992 0 160 0 0 0
21 2 1 20 22 5860.43 6.785 20 0 16.6992 0 180 0 0 0
22 2 1 21 12 5860.43 6.785 20 0 16.6992 0 200 0 0 0
23 3 1 33 24 5860.43 6.785 20 0 8.3496 14.4619 0 0 0 0
24 3 1 23 25 5860.43 6.785 20 0 8.3496 14.4619 20 0 0 0
25 3 1 24 26 5860.43 6.785 20 0 8.3496 14.4619 40 0 0 0
26 3 1 25 27 5860.43 6.785 20 0 8.3496 14.4619 60 0 0 0
27 3 1 26 28 5860.43 6.785 20 0 8.3496 14.4619 80 0 0 0
28 3 1 27 29 5860.43 6.785 20 0 8.3496 14.4619 100 0 0 0
29 3 1 28 30 5860.43 6.785 20 0 8.3496 14.4619 120 0 0 0
30 3 1 29 31 5860.43 6.785 20 0 8.3496 14.4619 140 0 0 0
31 3 1 30 32 5860.43 6.785 20 0 8.3496 14.4619 160 0 0 0
32 3 1 31 33 5860.43 6.785 20 0 8.3496 14.4619 180 0 0 0
33 3 1 32 23 5860.43 6.785 20 0 8.3496 14.4619 200 0 0 0
34 4 1 44 35 5860.43 6.785 20 0 -8.3496 14.4619 0 0 0 0
35 4 1 34 36 5860.43 6.785 20 0 -8.3496 14.4619 20 0 0 0
36 4 1 35 37 5860.43 6.785 20 0 -8.3496 14.4619 40 0 0 0
37 4 1 36 38 5860.43 6.785 20 0 -8.3496 14.4619 60 0 0 0
38 4 1 37 39 5860.43 6.785 20 0 -8.3496 14.4619 80 0 0 0
39 4 1 38 40 5860.43 6.785 20 0 -8.3496 14.4619 100 0 0 0
40 4 1 39 41 5860.43 6.785 20 0 -8.3496 14.4619 120 0 0 0
41 4 1 40 42 5860.43 6.785 20 0 -8.3496 14.4619 140 0 0 0
42 4 1 41 43 5860.43 6.785 20 0 -8.3496 14.4619 160 0 0 0
43 4 1 42 44 5860.43 6.785 20 0 -8.3496 14.4619 180 0 0 0
44 4 1 43 34 5860.43 6.785 20 0 -8.3496 14.4619 200 0 0 0
45 5 1 55 46 5860.43 6.785 20 0 -16.6992 0 0 0 0 0
46 5 1 45 47 5860.43 6.785 20 0 -16.6992 0 20 0 0 0
47 5 1 46 48 5860.43 6.785 20 0 -16.6992 0 40 0 0 0
48 5 1 47 49 5860.43 6.785 20 0 -16.6992 0 60 0 0 0
49 5 1 48 50 5860.43 6.785 20 0 -16.6992 0 80 0 0 0
50 5 1 49 51 5860.43 6.785 20 0 -16.6992 0 100 0 0 0
51 5 1 50 52 5860.43 6.785 20 0 -16.6992 0 120 0 0 0
52 5 1 51 53 5860.43 6.785 20 0 -16.6992 0 140 0 0 0
53 5 1 52 54 5860.43 6.785 20 0 -16.6992 0 160 0 0 0
54 5 1 53 55 5860.43 6.785 20 0 -16.6992 0 180 0 0 0
55 5 1 54 45 5860.43 6.785 20 0 -16.6992 0 200 0 0 0
56 6 1 66 57 5860.43 6.785 20 0 -8.3496 -14.4619 0 0 0 0
57 6 1 56 58 5860.43 6.785 20 0 -8.3496 -14.4619 20 0 0 0
58 6 1 57 59 5860.43 6.785 20 0 -8.3496 -14.4619 40 0 0 0
59 6 1 58 60 5860.43 6.785 20 0 -8.3496 -14.4619 60 0 0 0
60 6 1 59 61 5860.43 6.785 20 0 -8.3496 -14.4619 80 0 0 0
61 6 1 60 62 5860.43 6.785 20 0 -8.3496 -14.4619 100 0 0 0
62 6 1 61 63 5860.43 6.785 20 0 -8.3496 -14.4619 120 0 0 0
63 6 1 62 64 5860.43 6.785 20 0 -8.3496 -14.4619 140 0 0 0
64 6 1 63 65 5860.43 6.785 20 0 -8.3496 -14.4619 160 0 0 0
65 6 1 64 66 5860.43 6.785 20 0 -8.3496 -14.4619 180 0 0 0
66 6 1 65 56 5860.43 6.785 20 0 -8.3496 -14.4619 200 0 0 0
67 7 1 77 68 5860.43 6.785 20 0 8.3496 -14.4619 0 0 0 0
68 7 1 67 69 5860.43 6.785 20 0 8.3496 -14.4619 20 0 0 0
69 7 1 68 70 5860.43 6.785 20 0 8.3496 -14.4619 40 0 0 0
70 7 1 69 71 5860.43 6.785 20 0 8.3496 -14.4619 60 0 0 0
71 7 1 70 72 5860.43 6.785 20 0 8.3496 -14.4619 80 0 0 0
72 7 1 71 73 5860.43 6.785 20 0 8.3496 -14.4619 100 0 0 0
73 7 1 72 74 5860.43 6.785 20 0 8.3496 -14.4619 120 0 0 0
74 7 1 73 75 5860.43 6.785 20 0 8.3496 -14.4619 140 0 0 0
75 7 1 74 76 5860.43 6.785 20 0 8.3496 -14.4619 160 0 0 0
76 7 1 75 77 5860.43 6.785 20 0 8.3496 -14.4619 180 0 0 0
77 7 1 76 67 5860.43 6.785 20 0 8.3496 -14.4619 200 0 0 0

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, path, BendingMode, TPMType
pair_style cnt/tpm 25.0 ../../../potentials/CNT_10_10 0 0
read_data system.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 10
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

79612
examples/USER/cnt/system.init Normal file

File diff suppressed because it is too large Load Diff

734
lib/cnt/CNTPot.f90 Normal file
View File

@ -0,0 +1,734 @@
! ------------ ----------------------------------------------------------
! 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
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
integer*4, parameter :: CNTPOT_STRETCHING = 0
integer*4, parameter :: CNTPOT_SBUCKLING = 1
integer*4, parameter :: CNTPOT_SFRACTURE = 2
integer*4, parameter :: CNTPOT_BENDING = 3
integer*4, parameter :: CNTPOT_BBUCKLING = 4
integer*4, parameter :: CNTPOT_BFRACTURE = 5
integer*4, parameter :: CNTSTRMODEL_H0 = 0 ! Harmonic stetching model (constant Young's modulus)
integer*4, parameter :: CNTSTRMODEL_H1 = 1 ! Harmonic stretching model (Young's modulus depends on radius)
integer*4, parameter :: CNTSTRMODEL_NH0F = 2 ! Non-harmonic stretching with fracture, potential of type 0
integer*4, parameter :: CNTSTRMODEL_NH1 = 3 ! Non-harmonic stretching without fracture, potential of type 1
integer*4, parameter :: CNTSTRMODEL_NH1F = 4 ! Non-harmonic stretching with fracture, potential of type 1
integer*4, parameter :: CNTSTRMODEL_H1B = 5 ! Harmonic stetching model + axial buckling
integer*4, parameter :: CNTSTRMODEL_H1BH = 6 ! Harmonic stetching model + axial buckling + hysteresis
integer*4, parameter :: CNTBNDMODEL_H = 0 ! Harmonic bending model
integer*4, parameter :: CNTBNDMODEL_HB = 1 ! Harmonic bending - buckling model
integer*4, parameter :: CNTBNDMODEL_HBF = 2 ! Harmonic bending - buckling - fracture model
integer*4, parameter :: CNTBNDMODEL_HBH = 3 ! Harmonic bending - buckling + Hysteresis
integer*4, parameter :: CNTPOTNMAX = 4000 ! Maximal number of points in interpolation tables
!---------------------------------------------------------------------------------------------------
! Parameters of potentials
!---------------------------------------------------------------------------------------------------
! Stretching potential
integer*4 :: CNTSTRModel = CNTSTRMODEL_H1! Type of the bending model
integer*4 :: CNTSTRParams = 0 ! Type of parameterization
integer*4 :: CNTSTRYMT = 0 ! Type of dependence of the Young's modulus on tube radius
! Parameters of non-harmonic potential and fracture model
real*8 :: 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*8 :: CNTSTRD0 = 3.4d+00 ! CNT wall thickness (diameter of carbon atom), A
real*8 :: CNTSTREmin = -0.4d+00 ! Minimal strain in tabulated potential
real*8 :: CNTSTREmax = 0.13d+00 ! Maximal strain in tabulated potential. Simultaneously, U=0 if E> CNTSTREmax
real*8 :: CNTSTREl = 5.0d-02 ! Maximal linear strain
real*8 :: CNTSTREf = 12.0d-02 ! Strain at failure
real*8 :: CNTSTRS0 = 0.850e+12 ! Young's modulus, Pa
real*8 :: CNTSTRSl ! Maximal linear strees, Pa
real*8 :: CNTSTRSf = 75.0d+09 ! Tensile strength, Pa
real*8 :: CNTSTRF0 ! Elastic force constant, eV/A**2
real*8 :: CNTSTRFl ! Maximal linear force, eV/A**2
real*8 :: CNTSTRFf ! Tensile force at failure, eV/A**2
real*8 :: CNTSTRSi ! Maximal available stress (reference parameter, not used in the model), Pa
real*8 :: CNTSTRDf ! dF/dE at failure
real*8 :: CNTSTRAA, CNTSTRBB !
real*8 :: CNTSTRAAA, CNTSTRBBB ! | Auxilary constants
real*8 :: CNTSTRUl, CNTSTRUf ! /
! Axial buckling - hysteresis approch
real*8 :: CNTSTREc = -0.0142d+00 ! The minimal buckling strain
real*8 :: CNTSTREc1 = -0.04d+00 ! Critical axial buckling strain
real*8 :: CNTSTREc2 = -0.45d+00 ! Maximal buckling strain (the pot is harmonic for larger strains(in abs val))
!real*8 :: CNTSTRAmin
!real*8 :: CNTSTRAmax
!real*8 :: CNTSTRDA
! Bending potential
integer*4 :: CNTBNDModel = CNTBNDMODEL_H ! Type of the bending model
!real*8 :: CNTBNDAmin
!real*8 :: CNTBNDAmax
!real*8 :: CNTBNDDA
! Buckling model parameters
real*8 :: CNTBNDN = 1.0d+00 ! Buckling exponent
real*8 :: CNTBNDB = 0.68d+00 ! Buckling number
real*8 :: CNTBNDR = 275.0d+00 ! Critical radius of curvarure, A
! This is mean value for (10,10) SWCNT
real*8 :: CNTBNDTF = M_PI * 120.0d+00 / 180.0d+00 ! Fracture buckling angle, rad
real*8 :: CNTBNDN1
real*8 :: 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*4, 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*4 function CNTSTRH0Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus is independent of R
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: U, dUdL
real*8, intent(in) :: L, R0, L0
real*8 :: E
!-------------------------------------------------------------------------------------------
E = ( L - L0 ) / L0
dUdL = R0 * CNTSTRF0 * E
U = 0.5d+00 * L0 * E * dUdL
CNTSTRH0Calc = CNTPOT_STRETCHING
end function CNTSTRH0Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function CNTSTRH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus depends on R, see [4]
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: U, dUdL
real*8, intent(in) :: L, R0, L0
real*8 :: 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*4 function CNTSTRH1BCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus depends on R, see [4]
! Axial buckling without hysteresis
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: U, dUdL
real*8, intent(in) :: L, R0, L0
real*8 :: 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*4 function CNTSTRH1BHCalc ( U, dUdL, L, R0, L0, ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!
! Young's modulus depends on R, see [4]
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: U, dUdL, Ebuc
real*8, intent(in) :: L, R0, L0
integer*4, intent(in) :: ABF
!-------------------------------------------------------------------------------------------
real*8 :: E, K, dUbcl, Ebcl, Kbcl, Edu
real*8 :: 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*4 function CNTSTRNH0FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: U, dUdL
real*8, intent(in) :: L, R0, L0
real*8 :: 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*8 :: 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*4 function CNTSTRNH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: U, dUdL
real*8, intent(in) :: L, R0, L0
real*8 :: 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*4 function CNTSTRNH1FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: U, dUdL
real*8, intent(in) :: L, R0, L0
real*8 :: E, C, DE, t
!character*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*8 :: S, C, E, t
integer*4 :: 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*4 function CNTSTRCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function CNTSTRCalc ( U, dUdL, L, R0, L0 , ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: U, dUdL, Ebuc
real*8, intent(in) :: L, R0, L0
integer*4, 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*4, intent(in) :: STRModel, STRParams, YMType
real*8, intent(in) :: Rref
!real*8 :: A
!integer*4 :: 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*8, intent(inout) :: K
real*8, dimension(0:2), intent(inout) :: G0, G1, G2
real*8, dimension(0:2), intent(in) :: R0, R1, R2
real*8, dimension(0:2) :: DR0, DR2
real*8 :: 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*4 function CNTBNDHCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Bending model of type 0:
! Harmonic bending potential
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: U, dUdC
real*8, intent(in) :: C, R0, L0
real*8 :: 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*4 function CNTBNDHBCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Bending model of type 1:
! Harmonic bending potential with buckling
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: U, dUdC
real*8, intent(in) :: C, R0, L0
real*8 :: 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*4 function CNTBNDHBFCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: U, dUdC
real*8, intent(in) :: C, R0, L0
real*8 :: 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*4 function CNTBNDHBHCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!
! Bending model of type 1:
! Harmonic bending potential with buckling with hysteresis approch.
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: U, dUdC, Ebuc
real*8, intent(in) :: C , R0, L0
integer*4, intent(in) :: BBF
real*8 :: 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*4 function CNTBNDCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function CNTBNDCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: U, dUdC, Ebuc
real*8, intent(in) :: C, R0, L0
integer*4, 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*4, intent(in) :: BNDModel
real*8 :: A, E
integer*4 :: 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*4, intent(in) :: STRModel, STRParams, YMType, BNDModel
real*8, intent(in) :: Rref
!-------------------------------------------------------------------------------------------
call CNTSTRInit ( STRModel, STRParams, YMType, Rref )
call CNTBNDInit ( BNDModel )
end subroutine InitCNTPotModule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module CNTPot !*********************************************************************************

125
lib/cnt/ExportCNT.f90 Normal file
View File

@ -0,0 +1,125 @@
! ------------ ----------------------------------------------------------
! 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
implicit none
contains
subroutine InitCNTPotModule_(STRModel, STRParams, YMType, BNDModel, Rref) &
bind(c, name = "InitCNTPotModule")
integer*4, intent(in) :: STRModel, STRParams, YMType, BNDModel
real*8, intent(in) :: Rref
call InitCNTPotModule(STRModel, STRParams, YMType, BNDModel, Rref)
endsubroutine
subroutine TPBInit_() &
bind(c, name = "TPBInit")
call TPBInit()
endsubroutine
subroutine TPMInit_(M, N) &
bind(c, name = "TPMInit")
integer*4, intent(in) :: M, N
call TPMInit(M, N)
endsubroutine
subroutine SetTablePath_(TPMSSTPFile_, N1, TPMAFile_, N2) &
bind(c, name = "SetTablePath")
integer*4, intent(in) :: N1, N2
character, intent(in), dimension(N1) :: TPMSSTPFile_
character, 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 = "get_R")
real*8 :: get_R_
get_R_ = TPMR1
return
endfunction
subroutine TubeStretchingForceField_(U1, U2, F1, F2, S1, S2, X1, X2, R12, L12) &
bind(c, name = "TubeStretchingForceField")
real*8, intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2
real*8, intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2
real*8, intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor
real*8, intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes
real*8, intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real*8, 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 = "TubeBendingForceField")
real*8, intent(inout) :: U1, U2, U3 ! Interaction energies associated with nodes X1, X2, and X3
real*8, intent(inout), dimension(0:2) :: F1, F2, F3 ! Forces exerted on nodes X1, X2, and X3
real*8, intent(inout), dimension(0:2,0:2) :: S1, S2, S3 ! Contributions of nodes X1, X2, and X3 to the virial stress tensor
real*8, intent(in), dimension(0:2) :: X1, X2, X3 ! Coordinates of nodes
real*8, intent(in) :: R123 ! Radius of nanotube the segment (X1,X2) belongs to
real*8, intent(in) :: L123 ! Equilubrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments)
integer*4, 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 = "SegmentTubeForceField")
integer*4, intent(in) :: N ! Number of nodes in array X
real*8, intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2
real*8, intent(inout), dimension(0:N-1) :: U ! Interaction energies associated with nodes X
real*8, intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2
real*8, intent(inout), dimension(0:2,0:N-1) :: F ! Forces exerted on nodes X
real*8, intent(inout), dimension(0:2) :: Fe ! Force exerted on node Xe (can be updated only if Ee > 0)
real*8, intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor
real*8, intent(inout), dimension(0:2,0:2,0:N-1) :: S ! Contributions of nodes X to the virial stress tensor
real*8, 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*8, intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes
real*8, intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real*8, intent(in), dimension(0:2,0:N-1) :: X ! Coordinates of the nanotube nodes
real*8, intent(in), dimension(0:2) :: Xe ! Additional node of the extended chain if Ee > 0
integer*4, intent(in), dimension(0:N-1) :: BBF ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i)
real*8, intent(in) :: R ! Radius of nanotube X
integer*4, 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*4, intent(in) :: Ee ! Parameter defining the type of the extended chain (0,1,2)
integer*4, 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 !**************************************************************************

113
lib/cnt/LinFun2.f90 Normal file
View File

@ -0,0 +1,113 @@
! ------------ ----------------------------------------------------------
! 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
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
implicit none
contains !******************************************************************************************
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) )
A = 1.0d+00 - A0
CalcLinFun1_0 = A0 * F(i1) + A * F(i)
end function CalcLinFun1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcLinFun1_1 ( S, Sx1, i, X, N, P, F, Fx ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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) )
A = 1.0d+00 - A0
S = A0 * F(i1) + A * F(i)
Sx1 = A0 * Fx(i1) + A * Fx(i)
end subroutine CalcLinFun1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
A0 = ( P1(i) - X ) / ( P1(i) - P1(i1) )
A = 1.0d+00 - A0
B0 = ( P2(j) - Y ) / ( P2(j) - P2(j1) )
B = 1.0d+00 - B0
G = B0 * F(i,j1) + B * F(i,j)
G0 = B0 * F(i1,j1) + B * F(i1,j)
CalcLinFun2_0 = A0 * G0 + A * G
end function CalcLinFun2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcLinFun2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fx, Fy ) !!!!!!!!!!!!
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
A0 = ( P1(i) - X ) / ( P1(i) - P1(i1) )
A = 1.0d+00 - A0
B0 = ( P2(j) - Y ) / ( P2(j) - P2(j1) )
B = 1.0d+00 - B0
G = B0 * F(i,j1) + B * F(i,j)
G0 = B0 * F(i1,j1) + B * F(i1,j)
S = A0 * G0 + A * G
G = B0 * Fx(i,j1) + B * Fx(i,j)
G0 = B0 * Fx(i1,j1) + B * Fx(i1,j)
Sx1 = A0 * G0 + A * G
G = B0 * Fy(i,j1) + B * Fy(i,j)
G0 = B0 * Fy(i1,j1) + B * Fy(i1,j)
Sy1 = A0 * G0 + A * G
end subroutine CalcLinFun2_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module LinFun2 !********************************************************************************

56
lib/cnt/Makefile.gfortran Normal file
View File

@ -0,0 +1,56 @@
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 = libcnt.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 ../CNT.tar $(FILES)

52
lib/cnt/Makefile.ifort Normal file
View File

@ -0,0 +1,52 @@
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 = libcnt.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 ../CNT.tar $(FILES)

View File

@ -0,0 +1,5 @@
# Settings that the LAMMPS build will import when this package library is used
cnt_SYSINC =
cnt_SYSLIB = -lgfortran
cnt_SYSPATH =

View File

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

1
lib/cnt/Makefile.serial Normal file
View File

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

67
lib/cnt/README Normal file
View File

@ -0,0 +1,67 @@
USER-CNT 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.
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.
This library was created by Alexey N. Volkov, University of Alabama,
avolkov1@ua.edu.
--
References:
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.

193
lib/cnt/Spline1.f90 Normal file
View File

@ -0,0 +1,193 @@
! ------------ ----------------------------------------------------------
! 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
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
implicit none
contains !******************************************************************************************
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
end function ValueSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine ValueSpline1_1 ( S, S1, X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!
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
HL = X - Xi_1
HR = Xi - X
HL2 = HL * HL
HR2 = HR * HR
S = ( ( Mi_1 * HR2 * Hr + Mi * HL2 * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * HR + ( Yi - Mi * H26 ) * HL ) / Hi_1
S1 = ( ( Mi * HL2 - Mi_1 * HR2 ) / 2.0d+00 + Yi - Yi_1 ) / Hi_1 - H6 * ( Mi - Mi_1 )
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*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)
do i = 1, N - 1
D = - ( K1(i) + F(i-1) * K0(i) )
X(i) = ( K0(i) * X(i-1) - F(i) ) / D
F(i) = K2(i) / D
end do
do i = N - 2, 0, -1
X(i) = X(i) + F(i) * X(i+1)
end do
end subroutine sprogonka3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CreateSpline1 ( CL, CR, N, P, F, M, D, K0, K1, K2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
K1(i) = ( F(i) - F(i-1) ) / K0(i)
end do
select case ( CL )
case (1)
K1(0) = 2.0d+00 / 3.0d+00
K2(0) = 1.0d+00 / 3.0d+00
D (0) = 2 * ( K1(1) - M(0) ) / K0(1)
case (2)
K1(0) = 1.0d+00
K2(0) = 0.0d+00
D(0) = M(0)
case (3)
K1(0) = 1.0d+00
K2(0) = 0.0d+00
D(0) = 0.0d+00
end select
Z = K1(N-1)
do i = 1, N - 2
D(i) = 6.0d+00 * ( K1(i+1) - K1(i) )
K2(i) = K0(i+1)
K1(i) = 2.0d+00 * ( K2(i) + K0(i) )
end do
select case ( CR )
case (1)
D(N-1) = 2.0d+00 * ( M(N-1) - Z ) / K0(N-1)
K1(N-1) = 2.0d+00 / 3.0d+00
K0(N-1) = 1.0d+00 / 3.0d+00
case (2)
K1(N-1) = 1.0d+00
K0(N-1) = 0.0d+00
D(N-1) = M(N-1)
case (3)
K1(N-1) = 1.0d+00
K0(N-1) = 0.0d+00
D(N-1) = 0.0d+00
end select
call sprogonka3 ( N, K0, K1, K2, D, M )
end subroutine CreateSpline1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
HR = P(i) - X
H = P(i) - P(j)
H6 = H / 6.0d+00
H26 = H * H6
HL2 = HL * HL
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
end function CalcSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_1 ( S, S1, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
HR = P(i) - X
H = P(i) - P(j)
H6 = H / 6.0d+00
H26 = H * H6
HL2 = HL * HL
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) )
end subroutine CalcSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_2 ( S, S1, S2, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
HR = P(i) - X
H = P(i) - P(j)
H6 = H / 6.0d+00
H26 = H * H6
HL2 = HL * HL
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
end subroutine CalcSpline1_2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module Spline1 !********************************************************************************

186
lib/cnt/Spline2.f90 Normal file
View File

@ -0,0 +1,186 @@
! ------------ ----------------------------------------------------------
! 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
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
use Spline1
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*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)
MM(0) = Fxx(0,II)
MM(N1-1) = Fxx(N1-1,II)
call CreateSpline1 ( CL, CR, N1, P1, FF, MM, DD, K0, K1, K2 )
Fxx(0:N1-1,II) = MM(0:N1-1)
end do
do II = 0, N1 - 1
MM(0) = Fyy(II,0)
MM(N-1) = Fyy(II,N2-1)
FF(0:N2-1) = F(II,0:N2-1)
call CreateSpline1 ( CD, CU, N2, P2, FF, MM, DD, K0, K1, K2 )
Fyy(II,0:N2-1) = MM(0:N2-1)
end do
FF(0:N1-1) = Fyy(0:N1-1,0 )
call CreateSpline1 ( 3, 3, N1, P1, FF, MM, DD, K0, K1, K2 )
Fxxyy(0:N1-1,0) = MM(0:N1-1)
FF(0:N1-1) = Fyy(0:N1-1,N2-1 )
call CreateSpline1 ( 3, 3, N1, P1, FF, MM, DD, K0, K1, k2 )
Fxxyy(0:N1-1,N2-1) = MM(0:N1-1)
do II = 1, N1 - 2
MM(0) = Fxxyy(II,0)
MM(N-1) = Fxxyy(II,N2-1)
FF(0:N2-1) = Fxx(II,0:N2-1)
call CreateSpline1 ( 2 , 2, N2, P2, FF, MM, DD, K0, K1, K2 )
Fxxyy(II,0:N2-1) = MM(0:N2-1)
end do
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*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
Fxxyy = 0.0d+00
do II = 0, N2A
FF(0:N1-1) = F(0:N1-1,II)
MM(0) = Fxx(0,II)
MM(N1-1) = Fxx(N1-1,II)
call CreateSpline1 ( CL, CR, N1, P1, FF, MM, DD, K0, K1, K2 )
Fxx(0:N1-1,II) = MM(0:N1-1)
end do
do II = N2A + 1, N2 - 1
FF(0:N1-N1A-1) = F(N1A:N1-1,II)
MM(0) = Fxx(N1A,II)
MM(N1-N1A-1) = Fxx(N1-1,II)
call CreateSpline1 ( CL, CR, N1 - N1A, P1, FF, MM, DD, K0, K1, K2 )
Fxx(N1A:N1-1,II) = MM(0:N1-N1A-1)
end do
do II = 0, N1A - 1
MM(0) = Fyy(II,0)
MM(N2A) = Fyy(II,N2A)
FF(0:N2A) = F(II,0:N2A)
call CreateSpline1 ( CD, CU, N2A + 1, P2, FF, MM, DD, K0, K1, K2 )
Fyy(II,0:N2A) = MM(0:N2A)
end do
do II = N1A, N1 - 1
MM(0) = Fyy(II,0)
MM(N-1) = Fyy(II,N2-1)
FF(0:N2-1) = F(II,0:N2-1)
call CreateSpline1 ( CD, CU, N2, P2, FF, MM, DD, K0, K1, K2 )
Fyy(II,0:N2-1) = MM(0:N2-1)
end do
FF(0:N1-1) = Fyy(0:N1-1,0)
call CreateSpline1 ( 3, 3, N1, P1, FF, MM, DD, K0, K1, K2 )
Fxxyy(0:N1-1,0) = MM(0:N1-1)
FF(0:N1A) = Fyy(0:N1A,N2A)
call CreateSpline1 ( 3, 3, N1A + 1, P1, FF, MM, DD, K0, K1, K2 )
Fxxyy(0:N1A,N2A) = MM(0:N1A)
FF(0:N1-N1A-1) = Fyy(N1A:N1-1,N2-1 )
call CreateSpline1 ( 3, 3, N1-N1A, P1, FF, MM, DD, K0, K1, K2 )
Fxxyy(N1A:N1-1,N2-1) = MM(0:N1-N1A-1)
do II = 1, N1A
MM(0) = Fxxyy(II,0)
MM(N2A) = Fxxyy(II,N2A)
FF(0:N2A) = Fxx(II,0:N2A)
call CreateSpline1 ( 2 , 2, N2A + 1, P2, FF, MM, DD, K0, K1, K2 )
Fxxyy(II,0:N2A) = MM(0:N2A)
end do
do II = N1A + 1, N1 - 2
MM(0) = Fxxyy(II,0)
MM(N-1) = Fxxyy(II,N2-1)
FF(0:N2-1) = Fxx(II,0:N2-1)
call CreateSpline1 ( 2 , 2, N2, P2, FF, MM, DD, K0, K1, K2 )
Fxxyy(II,0:N2-1) = MM(0:N2-1)
end do
end subroutine CreateSpline2Ext !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
T = P2(j) - P2(j1)
Gy_0 = ValueSpline1_0 ( Y, P2(j), P2(j1), F(i,j), F(i,j1), Fyy(i,j), Fyy(i,j1), T )
Gy_1 = ValueSpline1_0 ( Y, P2(j), P2(j1), F(i1,j), F(i1,j1), Fyy(i1,j), Fyy(i1,j1), T )
Gxxy_0 = ValueSpline1_0 ( Y, P2(j), P2(j1), Fxx(i,j), Fxx(i,j1), Fxxyy(i,j), Fxxyy(i,j1), T )
Gxxy_1 = ValueSpline1_0 ( Y, P2(j), P2(j1), Fxx(i1,j), Fxx(i1,j1), Fxxyy(i1,j), Fxxyy(i1,j1), T )
CalcSpline2_0 = ValueSpline1_0 ( X, P1(i), P1(i1), Gy_0, Gy_1,Gxxy_0, Gxxy_1, P1(i) - P1(i1) )
end function CalcSpline2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!
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
T = P2(j) - P2(j1)
call ValueSpline1_1 ( Gy_0, Gyy_0, Y, P2(j), P2(j1), F(i,j), F(i,j1), Fyy(i,j), Fyy(i,j1), T )
call ValueSpline1_1 ( Gy_1, Gyy_1, Y, P2(j), P2(j1), F(i1,j), F(i1,j1), Fyy(i1,j), Fyy(i1,j1), T )
call ValueSpline1_1 ( Gxxy_0, Gxxyy_0, Y, P2(j), P2(j1), Fxx(i,j), Fxx(i,j1), Fxxyy(i,j), Fxxyy(i,j1), T )
call ValueSpline1_1 ( Gxxy_1, Gxxyy_1, Y, P2(j), P2(j1), Fxx(i1,j), Fxx(i1,j1), Fxxyy(i1,j), Fxxyy(i1,j1), T )
call ValueSpline1_1 ( S, Sx1, X, P1(i), P1(i1), Gy_0, Gy_1,Gxxy_0, Gxxy_1, P1(i) - P1(i1) )
Sy1 = ValueSpline1_0 ( X, P1(i), P1(i1), Gyy_0, Gyy_1,Gxxyy_0, Gxxyy_1, P1(i) - P1(i1) )
end subroutine CalcSpline2_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module Spline2 !********************************************************************************

290
lib/cnt/TPMForceField.f90 Normal file
View File

@ -0,0 +1,290 @@
! ------------ ----------------------------------------------------------
! 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
implicit none
contains !******************************************************************************************
subroutine TubeStretchingForceField ( U1, U2, F1, F2, S1, S2, X1, X2, R12, L12 ) !!!!!!!!!!!
real*8, intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2
real*8, intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2
real*8, intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor
real*8, intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes
real*8, intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real*8, intent(in) :: L12 ! Equilubrium length of segment (X1,X2)
!-------------------------------------------------------------------------------------------
integer*4 :: ii, jj, Event
real*8 :: U, F, LL, S, Ubcl
real*8, 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*8, intent(inout) :: U1, U2, U3 ! Interaction energies associated with nodes X1, X2, and X3
real*8, intent(inout), dimension(0:2) :: F1, F2, F3 ! Forces exerted on nodes X1, X2, and X3
real*8, intent(inout), dimension(0:2,0:2) :: S1, S2, S3 ! Contributions of nodes X1, X2, and X3 to the virial stress tensor
real*8, intent(in), dimension(0:2) :: X1, X2, X3 ! Coordinates of nodes
real*8, intent(in) :: R123 ! Radius of nanotube the segment (X1,X2) belongs to
real*8, intent(in) :: L123 ! Equilubrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments)
integer*4, intent(inout) :: BBF2
!-------------------------------------------------------------------------------------------
integer*4 :: ii, jj, Event
real*8 :: U, F, K, S, Ubcl
real*8, 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*4, intent(in) :: N ! Number of nodes in array X
real*8, intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2
real*8, intent(inout), dimension(0:N-1) :: U ! Interaction energies associated with nodes X
real*8, intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2
real*8, intent(inout), dimension(0:2,0:N-1) :: F ! Forces exerted on nodes X
real*8, intent(inout), dimension(0:2) :: Fe ! Force exerted on node Xe (can be updated only if Ee > 0)
real*8, intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor
real*8, intent(inout), dimension(0:2,0:2,0:N-1) :: S ! Contributions of nodes X to the virial stress tensor
real*8, 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*8, intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes
real*8, intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to
real*8, intent(in), dimension(0:2,0:N-1) :: X ! Coordinates of the nanotube nodes
real*8, intent(in), dimension(0:2) :: Xe ! Additiona node of the extended chain if Ee > 0
integer*4, intent(in), dimension(0:N-1) :: BBF ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i)
real*8, intent(in) :: R ! Radius of nanotube X
integer*4, 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*4, intent(in) :: Ee ! Parameter defining the type of the extended chain (0,1,2)
integer*4, intent(in) :: TPMType ! Type of the tubular potential (0 or 1)
!-------------------------------------------------------------------------------------------
integer*4 :: k, ii, jj, IntSign
integer*4 :: BType, EType, LocalTPMType
real*8, dimension(0:2,0:N-1) :: G1, G2
real*8, dimension(0:N-1) :: QQ
logical :: EType1, EType2
real*8, dimension(0:2) :: G, DG, DQ, XX
real*8 :: UT, DR, DS, DS1
real*8 :: xU1, xU2 ! Interaction energies associated with nodes X1 and X2
real*8, dimension(0:N-1) :: xU ! Interaction energies associated with nodes X
real*8, dimension(0:2) :: xF1, xF2 ! Forces exerted on nodes X1 and X2
real*8, dimension(0:2,0:N-1) :: xF ! Forces exerted on nodes X
real*8, 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 !**************************************************************************

159
lib/cnt/TPMGeom.f90 Normal file
View File

@ -0,0 +1,159 @@
! ------------ ----------------------------------------------------------
! 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
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
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 coortinates of the point accorning to periodic boundary conditions
! it order to makesure that the point is inside the computational cell
!-------------------------------------------------------------------------------------------
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 )
!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 neares 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, displacemets
! 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 !********************************************************************************

220
lib/cnt/TPMLib.f90 Normal file
View File

@ -0,0 +1,220 @@
! ------------ ----------------------------------------------------------
! 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
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
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 !*********************************************************************************

195
lib/cnt/TPMM0.f90 Normal file
View File

@ -0,0 +1,195 @@
! ------------ ----------------------------------------------------------
! 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
implicit none
contains !******************************************************************************************
integer*4 function TPMInteractionFSS ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2, EType )
real*8, intent(inout) :: Q, U
real*8, dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2
real*8, dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2
integer*4, intent(in) :: EType
!-------------------------------------------------------------------------------------------
real*8 :: Qa, Ua, Fd, L2
real*8, dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a, R2_3, R2, Laxis2, F
integer*4 :: 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*4 function TPMInteractionFW0 ( QQ, U, U1, U2, UU, F1, F2, F, G1, G2, R1, R2, N, NMAX, R )
real*8, intent(inout) :: U, U1, U2
integer*4, intent(in) :: N, NMAX
real*8, dimension(0:NMAX-1), intent(out) :: QQ, UU
real*8, dimension(0:2), intent(out) :: F1, F2
real*8, dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2
real*8, dimension(0:2), intent(in) :: R1, R2
real*8, dimension(0:2,0:NMAX-1), intent(in) :: R
!-------------------------------------------------------------------------------------------
integer*4 :: i, SType2, GeomID, EType
real*8 :: Ua
real*8, dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a
real*8, dimension(0:2) :: R1a, R2a, Laxis1, Laxis2, L12, DR
real*8 :: 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
lib/cnt/TPMM1.f90 Normal file
View File

@ -0,0 +1,379 @@
! ------------ ----------------------------------------------------------
! 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
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
! Maximal length of a segment chain
integer*4, parameter :: TPM_MAX_CHAIN = 100
!---------------------------------------------------------------------------------------------------
! Numerical parameters
!---------------------------------------------------------------------------------------------------
! Switching parameters
real*8 :: TPMC123 = 1.0d+00 ! Non-dimensional
real*8 :: TPMC3 = 10.0d+00 ! (A)
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
! These global variables are used to speedup calculations
real*8, dimension(0:2,0:TPM_MAX_CHAIN-1) :: E1, E2, EE1, EE2
real*8, dimension(0:2) :: Q1, Q2, Qe, Qe1, DR, Z1, Z2, S1, S2, Pe, Pe1
real*8, dimension(0:TPM_MAX_CHAIN-1) :: W, C
real*8, dimension(0:2) :: RR, E10
real*8 :: L10, D10
contains !******************************************************************************************
subroutine PairWeight1 ( W, E1_1, E1_2, E2_1, E2_2, R2_1, R2_2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: W
real*8, dimension(0:2), intent(out) :: E1_1, E1_2, E2_1, E2_2
real*8, dimension(0:2), intent(in) :: R2_1, R2_2
!-------------------------------------------------------------------------------------------
real*8 :: D, L20, D20, t, dWdD
real*8, 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*4 function EndWeight1 ( W, E1_1, E1_2, E2_1, E2_2, R1_1, R1_2, R2_1, R2_2 ) !!!!!!!!
real*8, intent(out) :: W
real*8, dimension(0:2), intent(out) :: E1_1, E1_2, E2_1, E2_2
real*8, dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2
!-------------------------------------------------------------------------------------------
real*8 :: D, L20
real*8 :: D1, D2, t, dWdD
real*8, 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*4 function TPMInteractionFC1 ( Q, U, F1, F2, P1, P2, Pe, Pe1, R1, R2, Q1, Q2, Qe, Qe1, EType )
real*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F1, F2, P1, P2, Pe, Pe1
real*8, dimension(0:2), intent(in) :: R1, R2, Q1, Q2, Qe, Qe1
integer*4, intent(in) :: EType
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2) :: M, QX, Me, F1a, F2a, P1a, P2a, F1b, F2b, P1b, P2b, ER1, ER2, EQe, EQe1
real*8 :: W, W1, D, Qa, Qb, Ua, Ub, L, Pee, Peea, Peeb, DU
integer*4 :: 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*4 function TPMInteractionFW1 ( QQ, U, U1, U2, UU, F1, F2, F, Fe, G1, G2, R1, R2, N, NMAX, R, Re, EType )
real*8, intent(out) :: U, U1, U2
integer*4, intent(in) :: N, NMAX, EType
real*8, dimension(0:NMAX-1), intent(out) :: QQ, UU
real*8, dimension(0:2), intent(out) :: F1, F2, Fe
real*8, dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2
real*8, dimension(0:2), intent(in) :: R1, R2, Re
real*8, dimension(0:2,0:NMAX-1), intent(in) :: R
!-------------------------------------------------------------------------------------------
integer*4 :: i, j
real*8 :: 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 !**********************************************************************************

332
lib/cnt/TubePotBase.f90 Normal file
View File

@ -0,0 +1,332 @@
! ------------ ----------------------------------------------------------
! 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.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!---------------------------------------------------------------------------------------------------
!
! This module contains basic parameters for all modules involved into calculations of tubular
! potentials.
!
! It includes definitions of
! -- TPBU, Lennard-Jones (12-6) potential
! -- TPBQ, Transfer function
!
! All default values are adjusted for non-bonded carbob-carbon interaction in carbon nanotubes.
!
!***************************************************************************************************
use TPMLib
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
! Types of the potential with respect to the breathing mode
integer*4, parameter :: TP_POT_MONO_R = 0
integer*4, parameter :: TP_POT_POLY_R = 1
! Maximal number of elements in corresponding tables
integer*4, parameter :: TPBNMAX = 2001
! Numerical constants
real*8, parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5
! Mass of C atom
real*8, parameter :: TPBMc = 12.0107d+00 ! (Da)
! Parameters of the Van der Waals inteaction between carbon atoms in graphene sheets, see
! Stuart S.J., Tutein A.B., Harrison J.A., J. Chem. Phys. 112(14), 2000
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
! Dresselhaus et al, Carbon 33(7), 1995
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*8, parameter :: TPBSHcc = 600.0d+00 / K_MDCU ! (eV/(Da*K))
! Cutoff distances for interactomic potential and transfer function
! Changes in these parameters can result in necessity to change some numerical parameters too.
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*8, parameter :: TPBQScc = TPBScc ! (A)
!real*8, parameter :: TPBQRcutoff1cc = 2.16d+00 * TPBScc ! (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 ()
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
real*8 :: TPBM = TPBMc ! Mass of an atom, Da
real*8 :: TPBE = TPBEcc ! Depth of the energy well in LJ (12-6) interatomic potential (eV)
real*8 :: TPBS = TPBScc ! Sigma parameter of LJ (12-6) 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*8 :: TPBRmin = TPBRmincc ! (A)
real*8 :: TPBRcutoff = TPBRcutoffcc ! (A)
real*8 :: TPBRcutoff1 = TPBRcutoff1cc ! (A)
! Physical parameters of the transfer function
real*8 :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A)
real*8 :: TPBQRcutoff1 = TPBQRcutoff1cc ! (A)
! Auxilary variables
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*4 :: TPBN = TPBNMAX
real*8 :: TPBDR
real*8, dimension(0:TPBNMAX-1) :: TPBQ
real*8, dimension(0:TPBNMAX-1) :: TPBU, TPBdUdR
contains !******************************************************************************************
integer*4 function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!TPBsizeof = sizeof ( TPBU ) + sizeof ( TPBdUdR )
TPBsizeof = 8 * ( size ( TPBQ ) + size ( TPBU ) + size ( TPBdUdR ) )
end function TPBsizeof !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Interpolation
!---------------------------------------------------------------------------------------------------
real*8 function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
!write ( TPErrMsg, '(a,e20.10,a,e20.10)' ) ': R < Rmin: R=', R, ', Rmin=', TPBRmin
!call Error ( 'TPBQInt0', TPErrMsg )
elseif ( R > TPBRcutoff ) then
TPBQInt0 = 0.0d+00
return
endif
RR = ( R - TPBRmin ) / TPBDR
i = int ( RR )
RR = RR - i
Z = 1.0d+00 - RR
TPBQInt0 = TPBQ(i) * Z + TPBQ(i+1) * RR
end function TPBQInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8 function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
!write ( TPErrMsg, '(a,e20.10,a,e20.10)' ) ': R < Rmin: R=', R, ', Rmin=', TPBRmin
!call Error ( 'TPBUInt0', TPErrMsg )
elseif ( R > TPBRcutoff ) then
TPBUInt0 = 0.0d+00
return
endif
RR = ( R - TPBRmin ) / TPBDR
i = int ( RR )
RR = RR - i
Z = 1.0d+00 - RR
TPBUInt0 = TPBU(i) * Z + TPBU(i+1) * RR
end function TPBUInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBUInt1 ( U, dUdR, R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: U, dUdR
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
!write ( TPErrMsg, '(a,e20.10,a,e20.10)' ) ': R < Rmin: R=', R, ', Rmin=', TPBRmin
!call Error ( 'TPBUInt1', TPErrMsg )
elseif ( R > TPBRcutoff ) then
TPBU = 0.0d+00
TPBdUdR = 0.0d+00
return
endif
RR = ( R - TPBRmin ) / TPBDR
i = int ( RR )
RR = RR - i
Z = 1.0d+00 - RR
U = TPBU(i) * Z + TPBU(i+1) * RR
dUdR = TPBdUdR(i) * Z + TPBdUdR(i+1) * RR
end subroutine TPBUInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Calculation
!---------------------------------------------------------------------------------------------------
real*8 function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, t, S
!-------------------------------------------------------------------------------------------
if ( R > TPBRcutoff ) then
TPBQCalc0 = 0.0d+00
else if ( R < TPBQR0 ) then
TPBQCalc0 = 1.0d+00
else
Z = TPBQS / R
Z = Z * Z * Z
Z = Z * Z
TPBQCalc0 = 4.0d+00 * ( 1.0d+00 - Z ) * Z
if ( R > TPBQRcutoff1 ) then
t = ( R - TPBQRcutoff1 ) / TPBQDRcutoff
S = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t )
TPBQCalc0 = TPBQCalc0 * S
endif
endif
end function TPBQCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8 function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, t, S
!-------------------------------------------------------------------------------------------
if ( R > TPBRcutoff ) then
TPBUCalc0 = 0.0d+00
else
Z = TPBS / R
Z = Z * Z * Z
Z = Z * Z
TPBUCalc0 = TPBE4 * ( Z - 1.0d+00 ) * Z
if ( R > TPBRcutoff1 ) then
t = ( R - TPBRcutoff1 ) / TPBDRcutoff
S = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t )
TPBUCalc0 = TPBUCalc0 * S
endif
endif
end function TPBUCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBUCalc1 ( U, dUdR, R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
dUdR = 0.0d+00
else
Z = TPBS / R
Z = Z * Z * Z
Z = Z * Z
U = TPBE4 * ( Z - 1.0d+00 ) * Z
dUdR = TPBE24 * ( 2.0d+00 * Z - 1.0d+00 ) * Z / R
if ( R > TPBRcutoff1 ) then
t = ( R - TPBRcutoff1 ) / TPBDRcutoff
S = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t )
dSdR = 6.0d+00 * t * ( t - 1.0d+00 ) / TPBDRcutoff
dUdR = dUdR * S + U * dSdR
U = U * S
endif
endif
end subroutine TPBUCalc1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBSegmentForces ( F1, F2, F, M, Laxis, 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*8, dimension(0:2) :: FF, MM, FFF
!-------------------------------------------------------------------------------------------
FF = 0.5d+00 * F
MM = M / L
call V3_V3xxV3 ( FFF, MM, Laxis )
F1 = FF - FFF
F2 = FF + FFF
end subroutine TPBSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Printing
!---------------------------------------------------------------------------------------------------
! subroutine TPBPrint ( FileName ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! character*(*), intent(in) :: FileName
! !-------------------------------------------------------------------------------------------
! integer*4 :: Fuid
! integer*4 :: i
! real*8 :: 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*8 :: R
integer*4 :: i
!-------------------------------------------------------------------------------------------
TPBE4 = 4.0d+00 * TPBE
TPBE24 = - 24.0d+00 * TPBE
TPBDRcutoff = TPBRcutoff - TPBRcutoff1
TPBQDRcutoff = TPBRcutoff - TPBQRcutoff1
TPBQR0 = TPBQS * 2.0d+00 ** ( 1.0d+00 / 6.0d+00 )
TPBDR = ( TPBRcutoff - TPBRmin ) / ( TPBN - 1 )
R = TPBRmin
do i = 0, TPBN - 1
TPBQ(i) = TPBQCalc0 ( R )
call TPBUCalc1 ( TPBU(i), TPBdUdR(i), R )
R = R + TPBDR
enddo
end subroutine TPBInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TubePotBase !****************************************************************************

1675
lib/cnt/TubePotMono.f90 Normal file

File diff suppressed because it is too large Load Diff

442
lib/cnt/TubePotTrue.f90 Normal file
View File

@ -0,0 +1,442 @@
! ------------ ----------------------------------------------------------
! 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
!
!---------------------------------------------------------------------------------------------------
!
! This module implements calculation of true potential and transfer functions for interaction
! between two cylinder segments of nanotubes by direct integration over the surfaces of both
! segments.
!
!***************************************************************************************************
use TPMGeom
use TubePotBase
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
integer*4, parameter :: TPTNXMAX = 257
integer*4, parameter :: TPTNEMAX = 128
!---------------------------------------------------------------------------------------------------
! Types
!---------------------------------------------------------------------------------------------------
type TPTSEG !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
type(TPTSEG) :: TPTSeg1, TPTSeg2 ! Two segments
contains !******************************************************************************************
subroutine TPTSegAxisVector ( S, Laxis ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
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*8, dimension(0:2), intent(out) :: Lrad
real*8, intent(in) :: Eps
!-------------------------------------------------------------------------------------------
real*8 :: Ce, Se
!-------------------------------------------------------------------------------------------
Ce = cos ( Eps )
Se = sin ( Eps )
Lrad(0) = Ce * S%M(0,0) + Se * S%M(1,0)
Lrad(1) = Ce * S%M(0,1) + Se * S%M(1,1)
Lrad(2) = Ce * S%M(0,2) + Se * S%M(1,2)
end subroutine TPTSegRadVector !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTRadiusVector ( S, R, X, Eps ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
real*8, dimension(0:2), intent(out) :: R
real*8, intent(in) :: X, Eps
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2) :: Laxis, Lrad
!-------------------------------------------------------------------------------------------
call TPTSegAxisVector ( S, Laxis )
call TPTSegRadVector ( S, Lrad, Eps )
R(0) = S%X + X * Laxis(0) + S%R * Lrad(0)
R(1) = S%Y + X * Laxis(1) + S%R * Lrad(1)
R(2) = S%Z + X * Laxis(2) + S%R * Lrad(2)
end subroutine TPTRadiusVector !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTCalcSegNodeTable ( S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
!-------------------------------------------------------------------------------------------
real*8 :: X, Eps
integer*4 :: i, j
!-------------------------------------------------------------------------------------------
X = - S%L / 2.0
call RotationMatrix3 ( S%M, S%Psi, S%Theta, S%Phi )
do i = 0, S%NX - 1
Eps = 0.0d+00
do j = 0, S%NE - 1
call TPTRadiusVector ( S, S%Rtab(i,j,0:2), X, Eps )
Eps = Eps + S%DE
end do
X = X + S%DX
end do
end subroutine TPTCalcSegNodeTable !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTSetSegPosition1 ( S, Rcenter, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
real*8, dimension(0:2), intent(in) :: Rcenter, Laxis
real*8, intent(in) :: L
!-------------------------------------------------------------------------------------------
S%L = L
S%DX = L / ( S%NX - 1 )
call EulerAngles ( S%Psi, S%Theta, Laxis )
S%Phi= 0.0d+00
S%X = Rcenter(0)
S%Y = Rcenter(1)
S%Z = Rcenter(2)
call TPTCalcSegNodeTable ( S )
end subroutine TPTSetSegPosition1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTSetSegPosition2 ( S, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
real*8, dimension(0:2), intent(in) :: R1, R2
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2) :: R, Laxis
real*8 :: L
!-------------------------------------------------------------------------------------------
R = 0.5 * ( R1 + R2 )
Laxis = R2 - R1
L = S_V3norm3 ( Laxis )
Laxis = Laxis / L
call TPTSetSegPosition1 ( S, R, Laxis, L )
end subroutine TPTSetSegPosition2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S1, S2
!-------------------------------------------------------------------------------------------
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
call TPTSegAxisVector ( S1, Laxis )
R(0) = S1%X
R(1) = S1%Y
R(2) = S1%Z
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) ) )
if ( Displacement > L1 .and. Displacement < L2 .and. D < S1%R ) then
TPTCheckIntersection = 1
return
end if
end do
end do
TPTCheckIntersection = 0
end function TPTCheckIntersection !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
real*8, intent(out) :: Xmin, Xmax
real*8, dimension(0:2), intent(in) :: Re
!-------------------------------------------------------------------------------------------
real*8 :: Displacement, Distance
real*8, dimension(0:2) :: Laxis, Q, R
!-------------------------------------------------------------------------------------------
call TPTSegAxisVector ( S, Laxis )
R(0) = S%X
R(1) = S%Y
R(2) = S%Z
call LinePoint ( Displacement, Q, R, Laxis, Re )
Distance = sqrt ( sqr ( Q(0) - Re(0) ) + sqr ( Q(1) - Re(1) ) + sqr ( Q(2) - Re(2) ) ) - S%R
if ( TPBRcutoff < Distance ) then
Xmin = 0.0d+00
Xmax = 0.0d+00
TPTCalcPointRange = 0
return
end if
Distance = sqrt ( TPBRcutoff * TPBRcutoff - Distance * Distance )
Xmin = Displacement - Distance
Xmax = Displacement + Distance
TPTCalcPointRange = 1
end function TPTCalcPointRange !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTGetEnds ( R1_1, R1_2, R2_1, R2_2, 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
R1_1(2) = X1_1
R1_2(0) = 0.0d+00
R1_2(1) = 0.0d+00
R1_2(2) = X1_2
R2_1(0) = H
R2_1(1) = - X2_1 * sin ( A )
R2_1(2) = X2_1 * cos ( A )
R2_2(0) = H
R2_2(1) = - X2_2 * sin ( A )
R2_2(2) = X2_2 * cos ( A )
end subroutine TPTGetEnds !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Tubular potential
!---------------------------------------------------------------------------------------------------
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*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*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
U = 0.0d+00
F = 0.0d+00
if ( TPTCalcPointRange ( S, Xmin, Xmax, R ) == 0 ) return
X = - S%L / 2.0
do i = 0, S%NX - 1
if ( X > Xmin .and. X < Xmax ) then
QQ = 0.0d+00
UU = 0.0d+00
FF = 0.0d+00
do j = 0, S%NE - 1
RR(0:2) = S%Rtab(i,j,0:2) - R(0:2)
Rabs = S_V3norm3 ( RR )
if ( Rabs < TPBRcutoff ) then
QQ = QQ + TPBQCalc0 ( Rabs )
call TPBUCalc1 ( UUU, FFF, Rabs )
UU = UU + UUU
FFF = FFF / Rabs
FF = FF + FFF * RR
TPTPointPotential = 1
end if
end do
if ( i == 0 .or. i == S%NX - 1 ) then
Q = Q + 0.5d+00 * QQ
U = U + 0.5d+00 * UU
F = F + 0.5d+00 * FF
else
Q = Q + QQ
U = U + UU
F = F + FF
end if
end if
X = X + S%DX
end do
Coeff = TPBD * S%DX * S%R * S%DE
Q = Q * S%DX * S%R * S%DE
U = U * Coeff
F = F * Coeff
end function TPTPointPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 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
! and applied to the i-th circular cross-section of the segment S.
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F, M
type(TPTSEG), intent(in) :: S, Ssource
integer*4, intent(in) :: i
!-------------------------------------------------------------------------------------------
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
U = 0.0d+00
F = 0.0d+00
M = 0.0d+00
Eps = 0.0d+00
do j = 0, S%NE - 1
call TPTSegRadVector ( S, Lrad, Eps )
if ( TPTPointPotential ( Qp, Up, Fp, S%Rtab(i,j,0:2), Ssource ) == 1 ) then
Q = Q + Qp
U = U + Up
F = F + Fp
R(0) = S%Rtab(i,j,0) - S%X
R(1) = S%Rtab(i,j,1) - S%Y
R(2) = S%Rtab(i,j,2) - S%Z
call V3_V3xxV3 ( Mp, R, Fp )
M = M + Mp
TPTSectionPotential = 1
end if
Eps = Eps + S%DE
end do
Coeff = TPBD * S%R * S%DE
Q = Q * S%R * S%DE
U = U * Coeff
F = F * Coeff
M = M * Coeff
end function TPTSectionPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F, M
type(TPTSEG), intent(in) :: S, Ssource
integer*4 :: i
real*8, dimension(0:2) :: Fc, Mc
real*8 :: Qc, Uc
!-------------------------------------------------------------------------------------------
TPTSegmentPotential = 0
Q = 0.0d+00
U = 0.0d+00
F = 0.0d+00
M = 0.0d+00
if ( TPTCheckIntersection ( S, Ssource ) == 1 ) then
TPTSegmentPotential = 2
return
end if
do i = 0, S%NX - 1
if ( TPTSectionPotential ( Qc, Uc, Fc, Mc, S, i, Ssource ) == 1 ) then
if ( i == 0 .or. i == S%NX - 1 ) then
Q = Q + 0.5d+00 * Qc
U = U + 0.5d+00 * Uc
F = F + 0.5d+00 * Fc
M = M + 0.5d+00 * Mc
else
Q = Q + Qc
U = U + Uc
F = F + Fc
M = M + Mc
end if
TPTSegmentPotential = 1
end if
end do
Q = Q * S%DX
U = U * S%DX
F = F * S%DX
M = M * S%DX
end function TPTSegmentPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Forces
!---------------------------------------------------------------------------------------------------
subroutine TPTSegmentForces ( F1, F2, F, M, Laxis, 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*8, dimension(0:2) :: MM, FF, FFF
!-------------------------------------------------------------------------------------------
FF = 0.5d+00 * F
MM = M / L
call V3_V3xxV3 ( FFF, MM, Laxis )
F1 = FF - FFF
F2 = FF + FFF
end subroutine TPTSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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 appliend to the ends of segments.
!-------------------------------------------------------------------------------------------
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*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 )
Laxis1 = R1_2 - R1_1
Laxis2 = R2_2 - R2_1
L1 = S_V3norm3 ( Laxis1 )
L2 = S_V3norm3 ( Laxis2 )
Laxis1 = Laxis1 / L1
Laxis2 = Laxis2 / L2
DR = R2 - R1
call TPTSetSegPosition1 ( TPTSeg1, R1, Laxis1, L1 )
call TPTSetSegPosition1 ( TPTSeg2, R2, Laxis2, L2 )
TPTInteractionF = TPTSegmentPotential ( Q, U, F1, M1, TPTSeg1, TPTSeg2 )
if ( TPTInteractionF .ne. 1 ) return
call V3_V3xxV3 ( M2, DR, F1 )
F2 = - F1
M2 = - M1 - M2
call TPTSegmentForces ( F1_1, F1_2, F1, M1, Laxis1, L1 )
call TPTSegmentForces ( F2_1, F2_2, F2, M2, Laxis2, L2 )
end function TPTInteractionF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Initialization
!---------------------------------------------------------------------------------------------------
subroutine TPTInit ( R1, R2, NX, NE ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R1, R2
integer*4, intent(in) :: NX, NE
!-------------------------------------------------------------------------------------------
TPTSeg1%X = 0.0d+00
TPTSeg1%Y = 0.0d+00
TPTSeg1%Z = 0.0d+00
TPTSeg1%Psi = 0.0d+00
TPTSeg1%Theta = 0.0d+00
TPTSeg1%Phi = 0.0d+00
TPTSeg1%R = R1
TPTSeg1%NX = NX
TPTSeg1%NE = NE
TPTSeg1%DE = M_2PI / NE
TPTSeg2%X = 0.0d+00
TPTSeg2%Y = 0.0d+00
TPTSeg2%Z = 0.0d+00
TPTSeg2%Psi = 0.0d+00
TPTSeg2%Theta = 0.0d+00
TPTSeg2%Phi = 0.0d+00
TPTSeg2%R = R2
TPTSeg2%NX = NX
TPTSeg2%NE = NE
TPTSeg2%DE = M_2PI / NE
end subroutine TPTInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TubePotTrue !****************************************************************************

View File

@ -0,0 +1,21 @@
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

File diff suppressed because it is too large Load Diff

67
src/USER-CNT/Install.sh Normal file
View File

@ -0,0 +1,67 @@
# Install/unInstall package files in LAMMPS
# mode = 0/1/2 for uninstall/install/update
mode=$1
# enforce using portable C locale
LC_ALL=C
export LC_ALL
# arg1 = file, arg2 = file it depends on
action () {
if (test $mode = 0) then
rm -f ../$1
elif (! cmp -s $1 ../$1) then
if (test -z "$2" || test -e ../$2) then
cp $1 ..
if (test $mode = 2) then
echo " updating src/$1"
fi
fi
elif (test -n "$2") then
if (test ! -e ../$2) then
rm -f ../$1
fi
fi
}
# all package files with no dependencies
for file in *.cpp *.h; do
test -f ${file} && action $file
done
# edit 2 Makefile.package files to include/exclude package info
if (test $1 = 1) then
if (test -e ../Makefile.package) then
sed -i -e 's/[^ \t]*cnt[^ \t]* //' ../Makefile.package
sed -i -e 's|^PKG_INC =[ \t]*|&-I../../lib/cnt |' ../Makefile.package
sed -i -e 's|^PKG_PATH =[ \t]*|&-L../../lib/cnt |' ../Makefile.package
sed -i -e 's|^PKG_LIB =[ \t]*|&-lcnt |' ../Makefile.package
sed -i -e 's|^PKG_SYSINC =[ \t]*|&$(cnt_SYSINC) |' ../Makefile.package
sed -i -e 's|^PKG_SYSLIB =[ \t]*|&$(cnt_SYSLIB) |' ../Makefile.package
sed -i -e 's|^PKG_SYSPATH =[ \t]*|&$(cnt_SYSPATH) |' ../Makefile.package
fi
if (test -e ../Makefile.package.settings) then
sed -i -e '/^include.*cnt.*$/d' ../Makefile.package.settings
# multiline form needed for BSD sed on Macs
sed -i -e '4 i \
include ..\/..\/lib\/cnt\/Makefile.lammps
' ../Makefile.package.settings
fi
elif (test $1 = 0) then
if (test -e ../Makefile.package) then
sed -i -e 's/[^ \t]*cnt[^ \t]* //' ../Makefile.package
fi
if (test -e ../Makefile.package.settings) then
sed -i -e '/^include.*cnt.*$/d' ../Makefile.package.settings
fi
fi

95
src/USER-CNT/README Normal file
View File

@ -0,0 +1,95 @@
USER-CNT 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.
--
This package was created by Maxim Shugaev (mvs9t@virginia.edu)
at the University of Virginia.
The Fortran library implementing basic level functions describing stretching,
bending, and intertube components of the mesoscopic CNT force field, used
by this package is developed by Alexey N. Volkov (avolkov1@ua.edu)
at the University of Alabama.
--
The following commands are contained in this package:
atom_style cnt
This command enables cnt atom_style containing variables used for
further commands in USER-CNT.
pair_style cnt/tpm cut table_path BendingMode TPMType
This command activates a pair_style describing CNT mesoscopic tubular
potential model (TPM) force field. "cut" is cutoff distance that should
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.
compute cnt/Es, cnt/Eb, cnt/Et, cnt/B
These commands allow for the evaluation of per atom values of stretching,
bending, and intertube interaction components of energies, and buckling
flags.
compute cnt/Es_tot, cnt/Eb_tot, cnt/Et_tot
These commands allow for the evaluation of total values of stretching,
bending, and intertube interaction energies.
--
References:
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.

View File

@ -0,0 +1,912 @@
/* -*- 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 "atom_vec_cnt.h"
#include "atom.h"
#include "comm.h"
#include "domain.h"
#include "modify.h"
#include "fix.h"
#include "memory.h"
#include "error.h"
#include "utils.h"
using namespace LAMMPS_NS;
/* ---------------------------------------------------------------------- */
AtomVecCNT::AtomVecCNT(LAMMPS *lmp) : AtomVec(lmp)
{
mass_type = 1;
comm_x_only = comm_f_only = 1;
size_forward = 3;
size_reverse = 3;
size_border = 13;
size_velocity = 3;
size_data_atom = 12;
size_data_vel = 4;
xcol_data = 10;
}
/* ----------------------------------------------------------------------
grow atom arrays
n = 0 grows arrays by a chunk
n > 0 allocates arrays to size n
------------------------------------------------------------------------- */
void AtomVecCNT::grow(int n)
{
if (n == 0) grow_nmax();
else nmax = n;
atom->nmax = nmax;
if (nmax < 0 || nmax > MAXSMALLINT)
error->one(FLERR,"Per-processor system is too big");
tag = memory->grow(atom->tag,nmax,"atom:tag");
type = memory->grow(atom->type,nmax,"atom:type");
mask = memory->grow(atom->mask,nmax,"atom:mask");
image = memory->grow(atom->image,nmax,"atom:image");
x = memory->grow(atom->x,nmax,3,"atom:x");
v = memory->grow(atom->v,nmax,3,"atom:v");
f = memory->grow(atom->f,nmax*comm->nthreads,3,"atom:f");
rmass = memory->grow(atom->rmass,nmax,"atom:rmass");
radius = memory->grow(atom->radius,nmax,"atom:radius");
length = memory->grow(atom->length,nmax,"atom:length");
buckling = memory->grow(atom->buckling,nmax,"atom:buckling");
molecule = memory->grow(atom->molecule,nmax,"atom:molecule");
bond_cnt = memory->grow(atom->bond_cnt,nmax,2,"atom:bond_cnt");
if (atom->nextra_grow)
for (int iextra = 0; iextra < atom->nextra_grow; iextra++)
modify->fix[atom->extra_grow[iextra]]->grow_arrays(nmax);
}
/* ----------------------------------------------------------------------
reset local array ptrs
------------------------------------------------------------------------- */
void AtomVecCNT::grow_reset()
{
tag = atom->tag; type = atom->type;
mask = atom->mask; image = atom->image;
x = atom->x; v = atom->v; f = atom->f;
rmass = atom->rmass;
radius = atom->radius;
length = atom->length;
buckling = atom->buckling;
molecule = atom->molecule;
bond_cnt = atom->bond_cnt;
}
/* ----------------------------------------------------------------------
copy atom I info to atom J
------------------------------------------------------------------------- */
void AtomVecCNT::copy(int i, int j, int delflag)
{
tag[j] = tag[i];
type[j] = type[i];
mask[j] = mask[i];
image[j] = image[i];
x[j][0] = x[i][0];
x[j][1] = x[i][1];
x[j][2] = x[i][2];
v[j][0] = v[i][0];
v[j][1] = v[i][1];
v[j][2] = v[i][2];
rmass[j] = rmass[i];
radius[j] = radius[i];
length[j] = length[i];
buckling[j] = buckling[i];
molecule[j] = molecule[i];
bond_cnt[j][0] = bond_cnt[i][0];
bond_cnt[j][1] = bond_cnt[i][1];
if (atom->nextra_grow)
for (int iextra = 0; iextra < atom->nextra_grow; iextra++)
modify->fix[atom->extra_grow[iextra]]->copy_arrays(i,j,delflag);
}
/* ---------------------------------------------------------------------- */
int AtomVecCNT::pack_comm(int n, int *list, double *buf,
int pbc_flag, int *pbc)
{
int i,j,m;
double dx,dy,dz;
m = 0;
if (pbc_flag == 0) {
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0];
buf[m++] = x[j][1];
buf[m++] = x[j][2];
}
} else {
if (domain->triclinic == 0) {
dx = pbc[0]*domain->xprd;
dy = pbc[1]*domain->yprd;
dz = pbc[2]*domain->zprd;
} else {
dx = pbc[0]*domain->xprd + pbc[5]*domain->xy + pbc[4]*domain->xz;
dy = pbc[1]*domain->yprd + pbc[3]*domain->yz;
dz = pbc[2]*domain->zprd;
}
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0] + dx;
buf[m++] = x[j][1] + dy;
buf[m++] = x[j][2] + dz;
}
}
return m;
}
/* ---------------------------------------------------------------------- */
int AtomVecCNT::pack_comm_vel(int n, int *list, double *buf,
int pbc_flag, int *pbc)
{
int i,j,m;
double dx,dy,dz,dvx,dvy,dvz;
m = 0;
if (pbc_flag == 0) {
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0];
buf[m++] = x[j][1];
buf[m++] = x[j][2];
buf[m++] = v[j][0];
buf[m++] = v[j][1];
buf[m++] = v[j][2];
}
} else {
if (domain->triclinic == 0) {
dx = pbc[0]*domain->xprd;
dy = pbc[1]*domain->yprd;
dz = pbc[2]*domain->zprd;
} else {
dx = pbc[0]*domain->xprd + pbc[5]*domain->xy + pbc[4]*domain->xz;
dy = pbc[1]*domain->yprd + pbc[3]*domain->yz;
dz = pbc[2]*domain->zprd;
}
if (!deform_vremap) {
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0] + dx;
buf[m++] = x[j][1] + dy;
buf[m++] = x[j][2] + dz;
buf[m++] = v[j][0];
buf[m++] = v[j][1];
buf[m++] = v[j][2];
}
} else {
dvx = pbc[0]*h_rate[0] + pbc[5]*h_rate[5] + pbc[4]*h_rate[4];
dvy = pbc[1]*h_rate[1] + pbc[3]*h_rate[3];
dvz = pbc[2]*h_rate[2];
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0] + dx;
buf[m++] = x[j][1] + dy;
buf[m++] = x[j][2] + dz;
if (mask[i] & deform_groupbit) {
buf[m++] = v[j][0] + dvx;
buf[m++] = v[j][1] + dvy;
buf[m++] = v[j][2] + dvz;
} else {
buf[m++] = v[j][0];
buf[m++] = v[j][1];
buf[m++] = v[j][2];
}
}
}
}
return m;
}
/* ---------------------------------------------------------------------- */
void AtomVecCNT::unpack_comm(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) {
x[i][0] = buf[m++];
x[i][1] = buf[m++];
x[i][2] = buf[m++];
}
}
/* ---------------------------------------------------------------------- */
void AtomVecCNT::unpack_comm_vel(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) {
x[i][0] = buf[m++];
x[i][1] = buf[m++];
x[i][2] = buf[m++];
v[i][0] = buf[m++];
v[i][1] = buf[m++];
v[i][2] = buf[m++];
}
}
/* ---------------------------------------------------------------------- */
int AtomVecCNT::pack_reverse(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) {
buf[m++] = f[i][0];
buf[m++] = f[i][1];
buf[m++] = f[i][2];
}
return m;
}
/* ---------------------------------------------------------------------- */
void AtomVecCNT::unpack_reverse(int n, int *list, double *buf)
{
int i,j,m;
m = 0;
for (i = 0; i < n; i++) {
j = list[i];
f[j][0] += buf[m++];
f[j][1] += buf[m++];
f[j][2] += buf[m++];
}
}
/* ---------------------------------------------------------------------- */
int AtomVecCNT::pack_border(int n, int *list, double *buf,
int pbc_flag, int *pbc)
{
int i,j,m;
double dx,dy,dz;
m = 0;
if (pbc_flag == 0) {
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0];
buf[m++] = x[j][1];
buf[m++] = x[j][2];
buf[m++] = ubuf(tag[j]).d;
buf[m++] = ubuf(type[j]).d;
buf[m++] = ubuf(mask[j]).d;
buf[m++] = rmass[j];
buf[m++] = radius[j];
buf[m++] = length[j];
buf[m++] = ubuf(buckling[j]).d;
buf[m++] = ubuf(molecule[j]).d;
buf[m++] = ubuf(bond_cnt[j][0]).d;
buf[m++] = ubuf(bond_cnt[j][1]).d;
}
} else {
if (domain->triclinic == 0) {
dx = pbc[0]*domain->xprd;
dy = pbc[1]*domain->yprd;
dz = pbc[2]*domain->zprd;
} else {
dx = pbc[0];
dy = pbc[1];
dz = pbc[2];
}
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0] + dx;
buf[m++] = x[j][1] + dy;
buf[m++] = x[j][2] + dz;
buf[m++] = ubuf(tag[j]).d;
buf[m++] = ubuf(type[j]).d;
buf[m++] = ubuf(mask[j]).d;
buf[m++] = rmass[j];
buf[m++] = radius[j];
buf[m++] = length[j];
buf[m++] = ubuf(buckling[j]).d;
buf[m++] = ubuf(molecule[j]).d;
buf[m++] = ubuf(bond_cnt[j][0]).d;
buf[m++] = ubuf(bond_cnt[j][1]).d;
}
}
if (atom->nextra_border)
for (int iextra = 0; iextra < atom->nextra_border; iextra++)
m += modify->fix[atom->extra_border[iextra]]->
pack_border(n,list,&buf[m]);
return m;
}
/* ---------------------------------------------------------------------- */
int AtomVecCNT::pack_border_vel(int n, int *list, double *buf,
int pbc_flag, int *pbc)
{
int i,j,m;
double dx,dy,dz,dvx,dvy,dvz;
m = 0;
if (pbc_flag == 0) {
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0];
buf[m++] = x[j][1];
buf[m++] = x[j][2];
buf[m++] = ubuf(tag[j]).d;
buf[m++] = ubuf(type[j]).d;
buf[m++] = ubuf(mask[j]).d;
buf[m++] = rmass[j];
buf[m++] = radius[j];
buf[m++] = length[j];
buf[m++] = ubuf(buckling[j]).d;
buf[m++] = ubuf(molecule[j]).d;
buf[m++] = ubuf(bond_cnt[j][0]).d;
buf[m++] = ubuf(bond_cnt[j][1]).d;
buf[m++] = v[j][0];
buf[m++] = v[j][1];
buf[m++] = v[j][2];
}
} else {
if (domain->triclinic == 0) {
dx = pbc[0]*domain->xprd;
dy = pbc[1]*domain->yprd;
dz = pbc[2]*domain->zprd;
} else {
dx = pbc[0];
dy = pbc[1];
dz = pbc[2];
}
if (!deform_vremap) {
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0] + dx;
buf[m++] = x[j][1] + dy;
buf[m++] = x[j][2] + dz;
buf[m++] = ubuf(tag[j]).d;
buf[m++] = ubuf(type[j]).d;
buf[m++] = ubuf(mask[j]).d;
buf[m++] = rmass[j];
buf[m++] = radius[j];
buf[m++] = length[j];
buf[m++] = ubuf(buckling[j]).d;
buf[m++] = ubuf(molecule[j]).d;
buf[m++] = ubuf(bond_cnt[j][0]).d;
buf[m++] = ubuf(bond_cnt[j][1]).d;
buf[m++] = v[j][0];
buf[m++] = v[j][1];
buf[m++] = v[j][2];
}
} else {
dvx = pbc[0]*h_rate[0] + pbc[5]*h_rate[5] + pbc[4]*h_rate[4];
dvy = pbc[1]*h_rate[1] + pbc[3]*h_rate[3];
dvz = pbc[2]*h_rate[2];
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = x[j][0] + dx;
buf[m++] = x[j][1] + dy;
buf[m++] = x[j][2] + dz;
buf[m++] = ubuf(tag[j]).d;
buf[m++] = ubuf(type[j]).d;
buf[m++] = ubuf(mask[j]).d;
buf[m++] = rmass[j];
buf[m++] = radius[j];
buf[m++] = length[j];
buf[m++] = ubuf(buckling[j]).d;
buf[m++] = ubuf(molecule[j]).d;
buf[m++] = ubuf(bond_cnt[j][0]).d;
buf[m++] = ubuf(bond_cnt[j][1]).d;
if (mask[i] & deform_groupbit) {
buf[m++] = v[j][0] + dvx;
buf[m++] = v[j][1] + dvy;
buf[m++] = v[j][2] + dvz;
} else {
buf[m++] = v[j][0];
buf[m++] = v[j][1];
buf[m++] = v[j][2];
}
}
}
}
if (atom->nextra_border)
for (int iextra = 0; iextra < atom->nextra_border; iextra++)
m += modify->fix[atom->extra_border[iextra]]->
pack_border(n,list,&buf[m]);
return m;
}
/* ---------------------------------------------------------------------- */
int AtomVecCNT::pack_border_hybrid(int n, int *list, double *buf)
{
int i,j,m;
m = 0;
for (i = 0; i < n; i++) {
j = list[i];
buf[m++] = rmass[j];
buf[m++] = radius[j];
buf[m++] = length[j];
buf[m++] = ubuf(buckling[j]).d;
buf[m++] = ubuf(molecule[j]).d;
buf[m++] = ubuf(bond_cnt[j][0]).d;
buf[m++] = ubuf(bond_cnt[j][1]).d;
}
return m;
}
/* ---------------------------------------------------------------------- */
void AtomVecCNT::unpack_border(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) {
if (i == nmax) grow(0);
x[i][0] = buf[m++];
x[i][1] = buf[m++];
x[i][2] = buf[m++];
tag[i] = (tagint) ubuf(buf[m++]).i;
type[i] = (int) ubuf(buf[m++]).i;
mask[i] = (int) ubuf(buf[m++]).i;
rmass[i] = buf[m++];
radius[i] = buf[m++];
length[i] = buf[m++];
buckling[i] = (int) ubuf(buf[m++]).i;
molecule[i] = (tagint) ubuf(buf[m++]).i;
bond_cnt[i][0] = (tagint) ubuf(buf[m++]).i;
bond_cnt[i][1] = (tagint) ubuf(buf[m++]).i;
}
if (atom->nextra_border)
for (int iextra = 0; iextra < atom->nextra_border; iextra++)
m += modify->fix[atom->extra_border[iextra]]->
unpack_border(n,first,&buf[m]);
}
/* ---------------------------------------------------------------------- */
void AtomVecCNT::unpack_border_vel(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) {
if (i == nmax) grow(0);
x[i][0] = buf[m++];
x[i][1] = buf[m++];
x[i][2] = buf[m++];
tag[i] = (tagint) ubuf(buf[m++]).i;
type[i] = (int) ubuf(buf[m++]).i;
mask[i] = (int) ubuf(buf[m++]).i;
rmass[i] = buf[m++];
radius[i] = buf[m++];
length[i] = buf[m++];
buckling[i] = (int) ubuf(buf[m++]).i;
molecule[i] = (tagint) ubuf(buf[m++]).i;
bond_cnt[i][0] = (tagint) ubuf(buf[m++]).i;
bond_cnt[i][1] = (tagint) ubuf(buf[m++]).i;
v[i][0] = buf[m++];
v[i][1] = buf[m++];
v[i][2] = buf[m++];
}
if (atom->nextra_border)
for (int iextra = 0; iextra < atom->nextra_border; iextra++)
m += modify->fix[atom->extra_border[iextra]]->
unpack_border(n,first,&buf[m]);
}
/* ---------------------------------------------------------------------- */
int AtomVecCNT::unpack_border_hybrid(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) {
rmass[i] = buf[m++];
radius[i] = buf[m++];
length[i] = buf[m++];
buckling[i] = (int) ubuf(buf[m++]).i;
molecule[i] = (tagint) ubuf(buf[m++]).i;
bond_cnt[i][0] = (tagint) ubuf(buf[m++]).i;
bond_cnt[i][1] = (tagint) ubuf(buf[m++]).i;
}
return m;
}
/* ----------------------------------------------------------------------
pack data for atom I for sending to another proc
xyz must be 1st 3 values, so comm::exchange() can test on them
------------------------------------------------------------------------- */
int AtomVecCNT::pack_exchange(int i, double *buf)
{
int m = 1;
buf[m++] = x[i][0];
buf[m++] = x[i][1];
buf[m++] = x[i][2];
buf[m++] = v[i][0];
buf[m++] = v[i][1];
buf[m++] = v[i][2];
buf[m++] = ubuf(tag[i]).d;
buf[m++] = ubuf(type[i]).d;
buf[m++] = ubuf(mask[i]).d;
buf[m++] = ubuf(image[i]).d;
buf[m++] = rmass[i];
buf[m++] = radius[i];
buf[m++] = length[i];
buf[m++] = ubuf(buckling[i]).d;
buf[m++] = ubuf(molecule[i]).d;
buf[m++] = ubuf(bond_cnt[i][0]).d;
buf[m++] = ubuf(bond_cnt[i][1]).d;
if (atom->nextra_grow)
for (int iextra = 0; iextra < atom->nextra_grow; iextra++)
m += modify->fix[atom->extra_grow[iextra]]->pack_exchange(i,&buf[m]);
buf[0] = m;
return m;
}
/* ---------------------------------------------------------------------- */
int AtomVecCNT::unpack_exchange(double *buf)
{
int nlocal = atom->nlocal;
if (nlocal == nmax) grow(0);
int m = 1;
x[nlocal][0] = buf[m++];
x[nlocal][1] = buf[m++];
x[nlocal][2] = buf[m++];
v[nlocal][0] = buf[m++];
v[nlocal][1] = buf[m++];
v[nlocal][2] = buf[m++];
tag[nlocal] = (tagint) ubuf(buf[m++]).i;
type[nlocal] = (int) ubuf(buf[m++]).i;
mask[nlocal] = (int) ubuf(buf[m++]).i;
image[nlocal] = (imageint) ubuf(buf[m++]).i;
rmass[nlocal] = buf[m++];
radius[nlocal] = buf[m++];
length[nlocal] = buf[m++];
buckling[nlocal] = (int) ubuf(buf[m++]).i;
molecule[nlocal] = (tagint) ubuf(buf[m++]).i;
bond_cnt[nlocal][0] = (tagint) ubuf(buf[m++]).i;
bond_cnt[nlocal][1] = (tagint) ubuf(buf[m++]).i;
if (atom->nextra_grow)
for (int iextra = 0; iextra < atom->nextra_grow; iextra++)
m += modify->fix[atom->extra_grow[iextra]]->
unpack_exchange(nlocal,&buf[m]);
atom->nlocal++;
return m;
}
/* ----------------------------------------------------------------------
size of restart data for all atoms owned by this proc
include extra data stored by fixes
------------------------------------------------------------------------- */
int AtomVecCNT::size_restart()
{
int i;
int nlocal = atom->nlocal;
int n = 18 * nlocal;
if (atom->nextra_restart)
for (int iextra = 0; iextra < atom->nextra_restart; iextra++)
for (i = 0; i < nlocal; i++)
n += modify->fix[atom->extra_restart[iextra]]->size_restart(i);
return n;
}
/* ----------------------------------------------------------------------
pack atom I's data for restart file including extra quantities
xyz must be 1st 3 values, so that read_restart can test on them
molecular types may be negative, but write as positive
------------------------------------------------------------------------- */
int AtomVecCNT::pack_restart(int i, double *buf)
{
int m = 1;
buf[m++] = x[i][0];
buf[m++] = x[i][1];
buf[m++] = x[i][2];
buf[m++] = ubuf(tag[i]).d;
buf[m++] = ubuf(type[i]).d;
buf[m++] = ubuf(mask[i]).d;
buf[m++] = ubuf(image[i]).d;
buf[m++] = rmass[i];
buf[m++] = radius[i];
buf[m++] = length[i];
buf[m++] = ubuf(buckling[i]).d;
buf[m++] = ubuf(molecule[i]).d;
buf[m++] = ubuf(bond_cnt[i][0]).d;
buf[m++] = ubuf(bond_cnt[i][1]).d;
buf[m++] = v[i][0];
buf[m++] = v[i][1];
buf[m++] = v[i][2];
if (atom->nextra_restart)
for (int iextra = 0; iextra < atom->nextra_restart; iextra++)
m += modify->fix[atom->extra_restart[iextra]]->pack_restart(i,&buf[m]);
buf[0] = m;
return m;
}
/* ----------------------------------------------------------------------
unpack data for one atom from restart file including extra quantities
------------------------------------------------------------------------- */
int AtomVecCNT::unpack_restart(double *buf)
{
int nlocal = atom->nlocal;
if (nlocal == nmax) {
grow(0);
if (atom->nextra_store)
memory->grow(atom->extra,nmax,atom->nextra_store,"atom:extra");
}
int m = 1;
x[nlocal][0] = buf[m++];
x[nlocal][1] = buf[m++];
x[nlocal][2] = buf[m++];
tag[nlocal] = (tagint) ubuf(buf[m++]).i;
type[nlocal] = (int) ubuf(buf[m++]).i;
mask[nlocal] = (int) ubuf(buf[m++]).i;
image[nlocal] = (imageint) ubuf(buf[m++]).i;
rmass[nlocal] = buf[m++];
radius[nlocal] = buf[m++];
length[nlocal] = buf[m++];
buckling[nlocal] = (int) ubuf(buf[m++]).i;
molecule[nlocal] = (tagint) ubuf(buf[m++]).i;
bond_cnt[nlocal][0] = (tagint) ubuf(buf[m++]).i;
bond_cnt[nlocal][1] = (tagint) ubuf(buf[m++]).i;
v[nlocal][0] = buf[m++];
v[nlocal][1] = buf[m++];
v[nlocal][2] = buf[m++];
double **extra = atom->extra;
if (atom->nextra_store) {
int size = static_cast<int> (buf[0]) - m;
for (int i = 0; i < size; i++) extra[nlocal][i] = buf[m++];
}
atom->nlocal++;
return m;
}
/* ----------------------------------------------------------------------
create one atom of itype at coord
set other values to defaults
------------------------------------------------------------------------- */
void AtomVecCNT::create_atom(int itype, double *coord)
{
int nlocal = atom->nlocal;
if (nlocal == nmax) grow(0);
tag[nlocal] = 0;
type[nlocal] = itype;
x[nlocal][0] = coord[0];
x[nlocal][1] = coord[1];
x[nlocal][2] = coord[2];
mask[nlocal] = 1;
image[nlocal] = ((imageint) IMGMAX << IMG2BITS) |
((imageint) IMGMAX << IMGBITS) | IMGMAX;
rmass[nlocal] = 1.0;
radius[nlocal] = 1.0;
length[nlocal] = 1.0;
buckling[nlocal] = 0;
molecule[nlocal] = 0;
bond_cnt[nlocal][0] = -1;
bond_cnt[nlocal][1] = -1;
v[nlocal][0] = 0.0;
v[nlocal][1] = 0.0;
v[nlocal][2] = 0.0;
atom->nlocal++;
}
/* ----------------------------------------------------------------------
unpack one line from Atoms section of data file
initialize other atom quantities
------------------------------------------------------------------------- */
void AtomVecCNT::data_atom(double *coord, imageint imagetmp, char **values)
{
int nlocal = atom->nlocal;
if (nlocal == nmax) grow(0);
tag[nlocal] = utils::tnumeric(FLERR,values[0],true,lmp);
molecule[nlocal] = utils::tnumeric(FLERR,values[1],true,lmp);
type[nlocal] = utils::inumeric(FLERR,values[2],true,lmp);
if (type[nlocal] <= 0 || type[nlocal] > atom->ntypes)
error->one(FLERR,"Invalid atom type in Atoms section of data file");
bond_cnt[nlocal][0] = utils::inumeric(FLERR,values[3],true,lmp);
bond_cnt[nlocal][1] = utils::inumeric(FLERR,values[4],true,lmp);
rmass[nlocal] = utils::numeric(FLERR,values[5],true,lmp);
radius[nlocal] = utils::numeric(FLERR,values[6],true,lmp);
length[nlocal] = utils::numeric(FLERR,values[7],true,lmp);
buckling[nlocal] = utils::numeric(FLERR,values[8],true,lmp);
x[nlocal][0] = coord[0];
x[nlocal][1] = coord[1];
x[nlocal][2] = coord[2];
image[nlocal] = imagetmp;
mask[nlocal] = 1;
v[nlocal][0] = 0.0;
v[nlocal][1] = 0.0;
v[nlocal][2] = 0.0;
atom->nlocal++;
}
/* ----------------------------------------------------------------------
unpack hybrid quantities from one line in Atoms section of data file
initialize other atom quantities for this sub-style
------------------------------------------------------------------------- */
int AtomVecCNT::data_atom_hybrid(int nlocal, char **values)
{
molecule[nlocal] = utils::tnumeric(FLERR,values[0],true,lmp);
bond_cnt[nlocal][0] = utils::inumeric(FLERR,values[1],true,lmp);
bond_cnt[nlocal][1] = utils::inumeric(FLERR,values[2],true,lmp);
rmass[nlocal] = utils::numeric(FLERR,values[3],true,lmp);
radius[nlocal] = utils::numeric(FLERR,values[4],true,lmp);
length[nlocal] = utils::numeric(FLERR,values[5],true,lmp);
buckling[nlocal] = utils::numeric(FLERR,values[6],true,lmp);
return 7;
}
/* ----------------------------------------------------------------------
pack atom info for data file including 3 image flags
------------------------------------------------------------------------- */
void AtomVecCNT::pack_data(double **buf)
{
int nlocal = atom->nlocal;
for (int i = 0; i < nlocal; i++) {
int m = 0;
buf[i][m++] = ubuf(tag[i]).d;
buf[i][m++] = ubuf(molecule[i]).d;
buf[i][m++] = ubuf(type[i]).d;
buf[i][m++] = ubuf(bond_cnt[i][0]).d;
buf[i][m++] = ubuf(bond_cnt[i][1]).d;
buf[i][m++] = rmass[i];
buf[i][m++] = radius[i];
buf[i][m++] = length[i];
buf[i][m++] = ubuf(buckling[i]).d;
buf[i][m++] = x[i][0];
buf[i][m++] = x[i][1];
buf[i][m++] = x[i][2];
buf[i][m++] = ubuf((image[i] & IMGMASK) - IMGMAX).d;
buf[i][m++] = ubuf((image[i] >> IMGBITS & IMGMASK) - IMGMAX).d;
buf[i][m++] = ubuf((image[i] >> IMG2BITS) - IMGMAX).d;
}
}
/* ----------------------------------------------------------------------
pack hybrid atom info for data file
------------------------------------------------------------------------- */
int AtomVecCNT::pack_data_hybrid(int i, double *buf)
{
int m = 0;
buf[m++] = ubuf(molecule[i]).d;
buf[m++] = ubuf(bond_cnt[i][0]).d;
buf[m++] = ubuf(bond_cnt[i][1]).d;
buf[m++] = rmass[i];
buf[m++] = radius[i];
buf[m++] = length[i];
buf[m++] = ubuf(buckling[i]).d;
return m;
}
/* ----------------------------------------------------------------------
write atom info to data file including 3 image flags
------------------------------------------------------------------------- */
void AtomVecCNT::write_data(FILE *fp, int n, double **buf)
{
for (int i = 0; i < n; i++)
fprintf(fp, TAGINT_FORMAT " " TAGINT_FORMAT " %d "
TAGINT_FORMAT " " TAGINT_FORMAT
" %-1.16e %-1.16e %-1.16e %d %-1.16e %-1.16e %-1.16e %d %d %d\n",
(tagint) ubuf(buf[i][0]).i, (tagint) ubuf(buf[i][1]).i,
(int) ubuf(buf[i][2]).i, (tagint) ubuf(buf[i][3]).i,
(tagint) ubuf(buf[i][4]).i,
buf[i][5], buf[i][6], buf[i][7], (int) ubuf(buf[i][8]).i,
buf[i][9], buf[i][10], buf[i][11],
(int) ubuf(buf[i][12]).i, (int) ubuf(buf[i][13]).i,
(int) ubuf(buf[i][14]).i);
}
/* ----------------------------------------------------------------------
write hybrid atom info to data file
------------------------------------------------------------------------- */
int AtomVecCNT::write_data_hybrid(FILE *fp, double *buf)
{
fprintf(fp," " TAGINT_FORMAT " " TAGINT_FORMAT " " TAGINT_FORMAT
" %-1.16e %-1.16e %-1.16e %d",
(tagint) ubuf(buf[0]).i, (tagint) ubuf(buf[1]).i, (tagint) ubuf(buf[2]).i,
buf[3], buf[4], buf[5], (int)ubuf(buf[6]).i);
return 7;
}
/* ----------------------------------------------------------------------
return # of bytes of allocated memory
------------------------------------------------------------------------- */
bigint AtomVecCNT::memory_usage()
{
bigint bytes = 0;
if (atom->memcheck("tag")) bytes += memory->usage(tag,nmax);
if (atom->memcheck("type")) bytes += memory->usage(type,nmax);
if (atom->memcheck("mask")) bytes += memory->usage(mask,nmax);
if (atom->memcheck("image")) bytes += memory->usage(image,nmax);
if (atom->memcheck("x")) bytes += memory->usage(x,nmax,3);
if (atom->memcheck("v")) bytes += memory->usage(v,nmax,3);
if (atom->memcheck("f")) bytes += memory->usage(f,nmax*comm->nthreads,3);
if (atom->memcheck("radius")) bytes += memory->usage(radius,nmax);
if (atom->memcheck("rmass")) bytes += memory->usage(rmass,nmax);
if (atom->memcheck("length")) bytes += memory->usage(length,nmax);
if (atom->memcheck("buckling")) bytes += memory->usage(buckling,nmax);
if (atom->memcheck("molecule")) bytes += memory->usage(molecule,nmax);
if (atom->memcheck("bond_cnt")) bytes += memory->usage(bond_cnt,nmax,2);
return bytes;
}

View File

@ -0,0 +1,92 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef ATOM_CLASS
AtomStyle(cnt,AtomVecCNT)
#else
#ifndef LMP_ATOM_VEC_CNT_H
#define LMP_ATOM_VEC_CNT_H
#include "atom_vec.h"
namespace LAMMPS_NS {
class AtomVecCNT : public AtomVec {
public:
AtomVecCNT(class LAMMPS *);
virtual ~AtomVecCNT() {}
void grow(int);
void grow_reset();
void copy(int, int, int);
virtual int pack_comm(int, int *, double *, int, int *);
virtual int pack_comm_vel(int, int *, double *, int, int *);
virtual void unpack_comm(int, int, double *);
virtual void unpack_comm_vel(int, int, double *);
int pack_reverse(int, int, double *);
void unpack_reverse(int, int *, double *);
virtual int pack_border(int, int *, double *, int, int *);
virtual int pack_border_vel(int, int *, double *, int, int *);
virtual void unpack_border(int, int, double *);
virtual void unpack_border_vel(int, int, double *);
int pack_border_hybrid(int, int *, double *);
int unpack_border_hybrid(int, int, double *);
virtual int pack_exchange(int, double *);
virtual int unpack_exchange(double *);
int size_restart();
int pack_restart(int, double *);
int unpack_restart(double *);
void create_atom(int, double *);
void data_atom(double *, imageint, char **);
int data_atom_hybrid(int, char **);
void pack_data(double **);
int pack_data_hybrid(int, double *);
void write_data(FILE *, int, double **);
int write_data_hybrid(FILE *, double *);
bigint memory_usage();
protected:
tagint *tag;
int *type,*mask;
imageint *image;
double **x,**v,**f;
double *rmass, *radius, *length;
int *buckling;
tagint **bond_cnt;
tagint *molecule;
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: Invalid atom_style command
Self-explanatory.
E: Invalid atom type in Atoms section of data file
Self-explanatory.
E: Per-processor system is too big
Self-explanatory.
*/

173
src/USER-CNT/cntlist.cpp Normal file
View File

@ -0,0 +1,173 @@
/* -*- 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 "cntlist.h"
#include <algorithm>
#include <cmath>
template<typename T>
void vector_union(std::vector<T>& v1, std::vector<T>& v2,
std::vector<T>& merged) {
std::sort(v1.begin(), v1.end());
std::sort(v2.begin(), v2.end());
merged.reserve(v1.size() + v2.size());
typename std::vector<T>::iterator it1 = v1.begin();
typename std::vector<T>::iterator it2 = v2.begin();
while (it1 != v1.end() && it2 != v2.end()) {
if (*it1 < *it2) {
if (merged.empty() || merged.back() < *it1) merged.push_back(*it1);
++it1;
}
else {
if (merged.empty() || merged.back() < *it2) merged.push_back(*it2);
++it2;
}
}
while (it1 != v1.end()) {
if (merged.empty() || merged.back() < *it1) merged.push_back(*it1);
++it1;
}
while (it2 != v2.end()) {
if (merged.empty() || merged.back() < *it2) merged.push_back(*it2);
++it2;
}
}
#ifndef NULL
#define NULL 0
#endif
CNTList::CNTList(const Atom* atom, const NeighList* nblist, double rc2){
if (atom == NULL || nblist == NULL) return;
//number of local atoms at the node
int nlocal = atom->nlocal;
//total number of atoms in the node and ghost shell
int nall = nlocal + atom->nghost;
tagint* const g_id = atom->tag;
tagint** const bonds = atom->bond_cnt;
tagint* const chain_id = atom->molecule;
//convert bonds to local id representation
array2003<int, 2> tmp_arr;
tmp_arr[0] = domain_end; tmp_arr[1] = domain_end;
chain_list.resize(nall, tmp_arr);
for (int i = 0; i < nall; i++) {
int nnb = nblist->numneigh[i];
for (int m = 0; m < 2; m++)
if (bonds[i][m] == cnt_end) chain_list[i][m] = cnt_end;
for (int j = 0; j < nnb; j++) {
int nb = nblist->firstneigh[i][j];
if (bonds[i][0] == g_id[nb]){
chain_list[i][0] = nb;
chain_list[nb][1] = i;
break;
}
}
}
//reorder chains: index list
//list of indexes for conversion FROM reordered representation
index_list.reserve(nall);
for (int i = 0; i < nall; i++) {
if (chain_list[i][0] == cnt_end || chain_list[i][0] == domain_end) {
index_list.push_back(i);
int idx = i;
while (1) {
idx = chain_list[idx][1];
if (idx == cnt_end || idx == domain_end) break;
else index_list.push_back(idx);
}
}
}
index_list_b.resize(nall); // convert index TO reordered representation
for (int i = 0; i < nall; i++) {
index_list_b[index_list[i]] = i;
}
//segment list
for (int i = 0; i < nlocal; i++) {
if (chain_list[i][0] != cnt_end && chain_list[i][0] != domain_end &&
g_id[i] < g_id[chain_list[i][0]]){
array2003<int, 2> tmp_c;
tmp_c[0] = i; tmp_c[1] = chain_list[i][0];
segments.push_back(tmp_c);
}
if (chain_list[i][1] != cnt_end && chain_list[i][1] != domain_end &&
g_id[i] < g_id[chain_list[i][1]]){
array2003<int, 2> tmp_c;
tmp_c[0] = i; tmp_c[1] = chain_list[i][1];
segments.push_back(tmp_c);
}
}
int nbonds = segments.size();
//triplets
for (int i = 0; i < nlocal; i++){
if (chain_list[i][0] != cnt_end && chain_list[i][0] != domain_end &&
chain_list[i][1] != cnt_end && chain_list[i][1] != domain_end)
triplets.push_back(get_triplet(i));
}
//segment neighbor list
nb_chains.resize(nbonds);
std::vector<int> nb_list_i[2], nb_list;
for (int i = 0; i < nbonds; i++) {
//union of nb lists
for (int m = 0; m < 2; m++) {
nb_list_i[m].resize(0);
int idx = segments[i][m];
if (idx >= nlocal) continue; //ghost nodes do not have a neighbor list
int nnb = nblist->numneigh[idx];
for (int j = 0; j < nnb; j++) {
int jdx = nblist->firstneigh[idx][j];
//no selfinteractions for nbs within the same tube
if (chain_id[jdx] == chain_id[idx] &&
std::abs(index_list_b[idx] - index_list_b[jdx]) <= 5) continue;
nb_list_i[m].push_back(index_list_b[jdx]);
}
}
vector_union(nb_list_i[0], nb_list_i[1], nb_list);
int nnb = nb_list.size();
if (nnb > 0) {
int idx_s = nb_list[0];
for (int j = 0; j < nnb; j++) {
//if nodes are not continous in the sorted representation
//or represent chain ends, create a new neighbor chain
int idx_next = chain_list[index_list[nb_list[j]]][1];
if ((j == nnb - 1) || (nb_list[j] + 1 != nb_list[j+1]) ||
(idx_next == cnt_end) || (idx_next == domain_end)) {
int idx_f = nb_list[j];
array2003<int, 2> chain;
chain[0] = idx_s;
chain[1] = nb_list[j];
//make sure that segments having at least one node
//in the neighbor list are included
int idx0 = index_list[chain[0]]; // real id of the ends
int idx1 = index_list[chain[1]];
if (chain_list[idx0][0] != cnt_end &&
chain_list[idx0][0] != domain_end) chain[0] -= 1;
if (chain_list[idx1][1] != cnt_end &&
chain_list[idx1][1] != domain_end) chain[1] += 1;
if(chain[0] != chain[1]) nb_chains[i].push_back(chain);
idx_s = (j == nnb - 1) ? -1 : nb_list[j + 1];
}
}
}
nb_list.resize(0);
}
}

117
src/USER-CNT/cntlist.h Normal file
View File

@ -0,0 +1,117 @@
/* -*- 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
------------------------------------------------------------------------- */
#pragma once
#include "neigh_list.h"
#include "atom.h"
#include <vector>
using namespace LAMMPS_NS;
//since LAMMPS is compiled with C++ 2003, define a substitution for std::array
template<typename T, int N>
class array2003{
public:
T& operator[] (int idx){ return data[idx];};
const T& operator[] (int idx) const{ return data[idx];};
private:
T data[N];
};
class CNTList {
public:
CNTList(const Atom* atom, const NeighList* nblist, double rc2);
~CNTList() {};
//list of segments
const std::vector<array2003<int,2> >& get_segments() const;
//list of triplets
const std::vector<array2003<int,3> >& get_triplets() const;
//list of neigbor chains [start,end] for segments
//(use idx() to get real indexes)
const std::vector<std::vector<array2003<int,2> > >& get_nbs() const;
//convert idx from sorted representation to real idx
int get_idx(int idx) const;
//return list of indexes for conversion from sorted representation
const std::vector<int>& get_idx_list() const;
//convert idx from real idx to sorted representation
int get_idxb(int idx) const;
//return list of indexes for conversion to sorted representation
const std::vector<int>& get_idxb_list() const;
//check if the node is the end of the tube
bool is_end(int idx) const;
array2003<int, 2> get_segment(int idx) const;
array2003<int, 3> get_triplet(int idx) const;
static const int cnt_end = -1;
static const int domain_end = -2;
private:
std::vector<array2003<int, 2> > chain_list, segments;
std::vector<array2003<int, 3> > triplets;
std::vector<std::vector<array2003<int, 2> > > nb_chains;
std::vector<int> index_list, index_list_b;
};
//=============================================================================
inline const std::vector<std::vector<array2003<int, 2> > > & CNTList::get_nbs()
const {
return nb_chains;
}
inline int CNTList::get_idx(int idx) const {
return index_list[idx];
}
inline const std::vector<int>& CNTList::get_idx_list() const {
return index_list;
};
inline int CNTList::get_idxb(int idx) const {
return index_list_b[idx];
}
inline const std::vector<int>& CNTList::get_idxb_list() const {
return index_list_b;
};
inline const std::vector<array2003<int, 2> > & CNTList::get_segments() const {
return segments;
}
inline const std::vector<array2003<int, 3> > & CNTList::get_triplets() const {
return triplets;
}
inline array2003<int, 2> CNTList::get_segment(int idx) const {
array2003<int, 2> result;
result[0] = chain_list[idx][0];
result[1] = idx;
return result;
}
inline array2003<int, 3> CNTList::get_triplet(int idx) const {
array2003<int, 3> result;
result[0] = chain_list[idx][0];
result[1] = idx;
result[2] = chain_list[idx][1];
return result;
}
inline bool CNTList::is_end(int idx) const {
return chain_list[idx][0] == cnt_end || chain_list[idx][1] == cnt_end;
};

View File

@ -0,0 +1,80 @@
/* -*- 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 "compute_cnt_B.h"
#include <cstring>
#include "atom.h"
#include "update.h"
#include "comm.h"
#include "force.h"
#include "bond.h"
#include "modify.h"
#include "memory.h"
#include "error.h"
#include <typeinfo>
using namespace LAMMPS_NS;
/* ---------------------------------------------------------------------- */
ComputeCNT_B::ComputeCNT_B(LAMMPS *lmp, int narg, char **arg) :
Compute(lmp, narg, arg),
buckling(NULL)
{
if (narg < 3) error->all(FLERR,"Illegal compute cnt/B command");
peratom_flag = 1;
size_peratom_cols = 0;
peatomflag = 1;
timeflag = 1;
comm_reverse = 0;
nmax = 0;
}
/* ---------------------------------------------------------------------- */
ComputeCNT_B::~ComputeCNT_B()
{
memory->destroy(buckling);
}
/* ---------------------------------------------------------------------- */
void ComputeCNT_B::compute_peratom()
{
int i;
// grow local buckling array if necessary
// needs to be atom->nmax in length
if (atom->nmax > nmax) {
memory->destroy(buckling);
nmax = atom->nmax;
memory->create(buckling,nmax,"cnt_B:buckling");
vector_atom = buckling;
}
int nlocal = atom->nlocal;
for (i = 0; i < nlocal; i++) buckling[i] = atom->buckling[i];
}
/* ---------------------------------------------------------------------
memory usage of local atom-based array
------------------------------------------------------------------------- */
double ComputeCNT_B::memory_usage()
{
double bytes = nmax * sizeof(int);
return bytes;
}

View File

@ -0,0 +1,51 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef COMPUTE_CLASS
ComputeStyle(cnt/B,ComputeCNT_B)
#else
#ifndef LMP_COMPUTE_CNT_B_ATOM_H
#define LMP_COMPUTE_CNT_B_ATOM_H
#include "compute.h"
namespace LAMMPS_NS {
class ComputeCNT_B : public Compute {
public:
ComputeCNT_B(class LAMMPS *, int, char **);
~ComputeCNT_B();
void init() {}
void compute_peratom();
double memory_usage();
private:
int nmax;
double *buckling;
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: Illegal compute cnt/B command
*/

View File

@ -0,0 +1,136 @@
/* -*- 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 "compute_cnt_Eb.h"
#include "pair_cnt_tpm.h"
#include <cstring>
#include "atom.h"
#include "update.h"
#include "comm.h"
#include "force.h"
#include "bond.h"
#include "modify.h"
#include "memory.h"
#include "error.h"
#include <typeinfo>
using namespace LAMMPS_NS;
/* ---------------------------------------------------------------------- */
ComputeCNT_Eb::ComputeCNT_Eb(LAMMPS *lmp, int narg, char **arg) :
Compute(lmp, narg, arg),
energy(NULL)
{
if (narg < 3) error->all(FLERR,"Illegal compute cnt/Eb command");
peratom_flag = 1;
size_peratom_cols = 0;
peatomflag = 1;
timeflag = 1;
comm_reverse = 1;
nmax = 0;
}
/* ---------------------------------------------------------------------- */
ComputeCNT_Eb::~ComputeCNT_Eb()
{
memory->destroy(energy);
}
/* ---------------------------------------------------------------------- */
void ComputeCNT_Eb::compute_peratom()
{
int i;
invoked_peratom = update->ntimestep;
if (update->eflag_atom != invoked_peratom)
error->all(FLERR,"Per-atom energy was not tallied on needed timestep");
// grow local energy array if necessary
// needs to be atom->nmax in length
if (atom->nmax > nmax) {
memory->destroy(energy);
nmax = atom->nmax;
memory->create(energy,nmax,"cnt_Eb:energy");
vector_atom = energy;
}
// npair includes ghosts if newton_bond is set
// ntotal includes ghosts if either newton flag is set
int nlocal = atom->nlocal;
int npair = nlocal;
if (force->newton) npair += atom->nghost;
int ntotal = nlocal;
if (force->newton) ntotal += atom->nghost;
// clear local energy array
for (i = 0; i < ntotal; i++) energy[i] = 0.0;
if (force->pair){
try {
PairCNTTPM* pair = dynamic_cast<PairCNTTPM*>(force->pair);
for (i = 0; i < npair; i++) energy[i] += pair->eatom_b[i];
}
catch (std::bad_cast& bc){
error->all(FLERR,"cnt/Eb is allowed only with cnt pair style");
}
}
// communicate ghost energy between neighbor procs
if (force->newton) comm->reverse_comm_compute(this);
// zero energy of atoms not in group
// only do this after comm since ghost contributions must be included
int *mask = atom->mask;
for (i = 0; i < nlocal; i++)
if (!(mask[i] & groupbit)) energy[i] = 0.0;
}
/* ---------------------------------------------------------------------- */
int ComputeCNT_Eb::pack_reverse_comm(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) buf[m++] = energy[i];
return m;
}
/* ---------------------------------------------------------------------- */
void ComputeCNT_Eb::unpack_reverse_comm(int n, int *list, double *buf)
{
int i,j,m;
m = 0;
for (i = 0; i < n; i++) {
j = list[i];
energy[j] += buf[m++];
}
}
/* ----------------------------------------------------------------------
memory usage of local atom-based array
------------------------------------------------------------------------- */
double ComputeCNT_Eb::memory_usage()
{
double bytes = nmax * sizeof(double);
return bytes;
}

View File

@ -0,0 +1,63 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef COMPUTE_CLASS
ComputeStyle(cnt/Eb,ComputeCNT_Eb)
#else
#ifndef LMP_COMPUTE_CNT_EB_ATOM_H
#define LMP_COMPUTE_CNT_EB_ATOM_H
#include "compute.h"
namespace LAMMPS_NS {
class ComputeCNT_Eb : public Compute {
public:
ComputeCNT_Eb(class LAMMPS *, int, char **);
~ComputeCNT_Eb();
void init() {}
void compute_peratom();
int pack_reverse_comm(int, int, double *);
void unpack_reverse_comm(int, int *, double *);
double memory_usage();
private:
int nmax;
double *energy;
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: Illegal compute cnt/Eb command
Incorrect argument list in the compute init.
E: Per-atom energy was not tallied on needed timestep
UNSPECIFIED.
E: cnt/Eb is allowed only with cnt pair style
Use cnt pair style.
*/

View File

@ -0,0 +1,64 @@
/* -*- 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 "compute_cnt_Eb_tot.h"
#include "pair_cnt_tpm.h"
#include <mpi.h>
#include <cstring>
#include "atom.h"
#include "update.h"
#include "force.h"
#include "bond.h"
#include "modify.h"
#include "domain.h"
#include "error.h"
#include <typeinfo>
using namespace LAMMPS_NS;
/* ---------------------------------------------------------------------- */
ComputeCNT_Eb_tot::ComputeCNT_Eb_tot(LAMMPS *lmp, int narg, char **arg) :
Compute(lmp, narg, arg)
{
if (narg < 3) error->all(FLERR,"Illegal compute cnt/Eb_tot command");
if (igroup) error->all(FLERR,"Compute cnt/Eb_tot must use group all");
timeflag = 1;
extscalar = 1;
scalar_flag = 1;
}
/* ---------------------------------------------------------------------- */
double ComputeCNT_Eb_tot::compute_scalar()
{
invoked_scalar = update->ntimestep;
if (update->eflag_global != invoked_scalar)
error->all(FLERR,"Energy was not tallied on needed timestep");
double one = 0.0;
if (force->pair){
try {
PairCNTTPM* pair = dynamic_cast<PairCNTTPM*>(force->pair);
one += pair->energy_b;
}
catch (std::bad_cast& bc){
error->all(FLERR,"cnt/Eb_tot is allowed only with cnt pair style");
}
}
MPI_Allreduce(&one,&scalar,1,MPI_DOUBLE,MPI_SUM,world);
return scalar;
}

View File

@ -0,0 +1,56 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef COMPUTE_CLASS
ComputeStyle(cnt/Eb_tot,ComputeCNT_Eb_tot)
#else
#ifndef LMP_COMPUTE_CNT_EB_H
#define LMP_COMPUTE_CNT_EB_H
#include "compute.h"
namespace LAMMPS_NS {
class ComputeCNT_Eb_tot : public Compute {
public:
ComputeCNT_Eb_tot(class LAMMPS *, int, char **);
~ComputeCNT_Eb_tot() {}
void init() {}
double compute_scalar();
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: Illegal compute cnt/Eb_tot command
Incorrect argument list in the compute init.
E: Compute cnt/Eb_tot must use group all
UNSPECIFIED.
E: cnt/Eb_tot is allowed only with cnt pair style
Use cnt pair style.
*/

View File

@ -0,0 +1,136 @@
/* -*- 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 "compute_cnt_Es.h"
#include "pair_cnt_tpm.h"
#include <cstring>
#include "atom.h"
#include "update.h"
#include "comm.h"
#include "force.h"
#include "bond.h"
#include "modify.h"
#include "memory.h"
#include "error.h"
#include <typeinfo>
using namespace LAMMPS_NS;
/* ---------------------------------------------------------------------- */
ComputeCNT_Es::ComputeCNT_Es(LAMMPS *lmp, int narg, char **arg) :
Compute(lmp, narg, arg),
energy(NULL)
{
if (narg < 3) error->all(FLERR,"Illegal compute cnt/Es command");
peratom_flag = 1;
size_peratom_cols = 0;
peatomflag = 1;
timeflag = 1;
comm_reverse = 1;
nmax = 0;
}
/* ---------------------------------------------------------------------- */
ComputeCNT_Es::~ComputeCNT_Es()
{
memory->destroy(energy);
}
/* ---------------------------------------------------------------------- */
void ComputeCNT_Es::compute_peratom()
{
int i;
invoked_peratom = update->ntimestep;
if (update->eflag_atom != invoked_peratom)
error->all(FLERR,"Per-atom energy was not tallied on needed timestep");
// grow local energy array if necessary
// needs to be atom->nmax in length
if (atom->nmax > nmax) {
memory->destroy(energy);
nmax = atom->nmax;
memory->create(energy,nmax,"cnt_Es:energy");
vector_atom = energy;
}
// npair includes ghosts if newton_bond is set
// ntotal includes ghosts if either newton flag is set
int nlocal = atom->nlocal;
int npair = nlocal;
if (force->newton) npair += atom->nghost;
int ntotal = nlocal;
if (force->newton) ntotal += atom->nghost;
// clear local energy array
for (i = 0; i < ntotal; i++) energy[i] = 0.0;
if (force->pair){
try {
PairCNTTPM* pair = dynamic_cast<PairCNTTPM*>(force->pair);
for (i = 0; i < npair; i++) energy[i] += pair->eatom_s[i];
}
catch (std::bad_cast& bc){
error->all(FLERR,"cnt_Es is allowed only with cnt pair style");
}
}
// communicate ghost energy between neighbor procs
if (force->newton) comm->reverse_comm_compute(this);
// zero energy of atoms not in group
// only do this after comm since ghost contributions must be included
int *mask = atom->mask;
for (i = 0; i < nlocal; i++)
if (!(mask[i] & groupbit)) energy[i] = 0.0;
}
/* ---------------------------------------------------------------------- */
int ComputeCNT_Es::pack_reverse_comm(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) buf[m++] = energy[i];
return m;
}
/* ---------------------------------------------------------------------- */
void ComputeCNT_Es::unpack_reverse_comm(int n, int *list, double *buf)
{
int i,j,m;
m = 0;
for (i = 0; i < n; i++) {
j = list[i];
energy[j] += buf[m++];
}
}
/* ----------------------------------------------------------------------
memory usage of local atom-based array
------------------------------------------------------------------------- */
double ComputeCNT_Es::memory_usage()
{
double bytes = nmax * sizeof(double);
return bytes;
}

View File

@ -0,0 +1,63 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef COMPUTE_CLASS
ComputeStyle(cnt/Es,ComputeCNT_Es)
#else
#ifndef LMP_COMPUTE_CNT_ES_ATOM_H
#define LMP_COMPUTE_CNT_ES_ATOM_H
#include "compute.h"
namespace LAMMPS_NS {
class ComputeCNT_Es : public Compute {
public:
ComputeCNT_Es(class LAMMPS *, int, char **);
~ComputeCNT_Es();
void init() {}
void compute_peratom();
int pack_reverse_comm(int, int, double *);
void unpack_reverse_comm(int, int *, double *);
double memory_usage();
private:
int nmax;
double *energy;
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: Illegal compute cnt/Es command
Incorrect argument list in the compute init.
E: Per-atom energy was not tallied on needed timestep
UNSPECIFIED.
E: cnt/Es is allowed only with cnt pair style
Use cnt pair style.
*/

View File

@ -0,0 +1,64 @@
/* -*- 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 "compute_cnt_Es_tot.h"
#include "pair_cnt_tpm.h"
#include <mpi.h>
#include <cstring>
#include "atom.h"
#include "update.h"
#include "force.h"
#include "bond.h"
#include "modify.h"
#include "domain.h"
#include "error.h"
#include <typeinfo>
using namespace LAMMPS_NS;
/* ---------------------------------------------------------------------- */
ComputeCNT_Es_tot::ComputeCNT_Es_tot(LAMMPS *lmp, int narg, char **arg) :
Compute(lmp, narg, arg)
{
if (narg < 3) error->all(FLERR,"Illegal compute cnt/Es_tot command");
if (igroup) error->all(FLERR,"Compute cnt/Es_tot must use group all");
timeflag = 1;
extscalar = 1;
scalar_flag = 1;
}
/* ---------------------------------------------------------------------- */
double ComputeCNT_Es_tot::compute_scalar()
{
invoked_scalar = update->ntimestep;
if (update->eflag_global != invoked_scalar)
error->all(FLERR,"Energy was not tallied on needed timestep");
double one = 0.0;
if (force->pair){
try {
PairCNTTPM* pair = dynamic_cast<PairCNTTPM*>(force->pair);
one += pair->energy_s;
}
catch (std::bad_cast& bc){
error->all(FLERR,"cnt/Es_tot is allowed only with cnt pair style");
}
}
MPI_Allreduce(&one,&scalar,1,MPI_DOUBLE,MPI_SUM,world);
return scalar;
}

View File

@ -0,0 +1,56 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef COMPUTE_CLASS
ComputeStyle(cnt/Es_tot,ComputeCNT_Es_tot)
#else
#ifndef LMP_COMPUTE_CNT_ES_H
#define LMP_COMPUTE_CNT_ES_H
#include "compute.h"
namespace LAMMPS_NS {
class ComputeCNT_Es_tot : public Compute {
public:
ComputeCNT_Es_tot(class LAMMPS *, int, char **);
~ComputeCNT_Es_tot() {}
void init() {}
double compute_scalar();
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: Illegal compute cnt/Es_tot command
Incorrect argument list in the compute init.
E: Compute cnt/Es_tot must use group all
UNSPECIFIED.
E: cnt/Es_tot is allowed only with cnt pair style
Use cnt pair style.
*/

View File

@ -0,0 +1,136 @@
/* -*- 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 "compute_cnt_Et.h"
#include "pair_cnt_tpm.h"
#include <cstring>
#include "atom.h"
#include "update.h"
#include "comm.h"
#include "force.h"
#include "bond.h"
#include "modify.h"
#include "memory.h"
#include "error.h"
#include <typeinfo>
using namespace LAMMPS_NS;
/* ---------------------------------------------------------------------- */
ComputeCNT_Et::ComputeCNT_Et(LAMMPS *lmp, int narg, char **arg) :
Compute(lmp, narg, arg),
energy(NULL)
{
if (narg < 3) error->all(FLERR,"Illegal compute cnt/Et command");
peratom_flag = 1;
size_peratom_cols = 0;
peatomflag = 1;
timeflag = 1;
comm_reverse = 1;
nmax = 0;
}
/* ---------------------------------------------------------------------- */
ComputeCNT_Et::~ComputeCNT_Et()
{
memory->destroy(energy);
}
/* ---------------------------------------------------------------------- */
void ComputeCNT_Et::compute_peratom()
{
int i;
invoked_peratom = update->ntimestep;
if (update->eflag_atom != invoked_peratom)
error->all(FLERR,"Per-atom energy was not tallied on needed timestep");
// grow local energy array if necessary
// needs to be atom->nmax in length
if (atom->nmax > nmax) {
memory->destroy(energy);
nmax = atom->nmax;
memory->create(energy,nmax,"cnt_Et:energy");
vector_atom = energy;
}
// npair includes ghosts if newton_bond is set
// ntotal includes ghosts if either newton flag is set
int nlocal = atom->nlocal;
int npair = nlocal;
if (force->newton) npair += atom->nghost;
int ntotal = nlocal;
if (force->newton) ntotal += atom->nghost;
// clear local energy array
for (i = 0; i < ntotal; i++) energy[i] = 0.0;
if (force->pair){
try {
PairCNTTPM* pair = dynamic_cast<PairCNTTPM*>(force->pair);
for (i = 0; i < npair; i++) energy[i] += pair->eatom_t[i];
}
catch (std::bad_cast& bc){
error->all(FLERR,"cnt/Et is allowed only with cnt pair style");
}
}
// communicate ghost energy between neighbor procs
if (force->newton) comm->reverse_comm_compute(this);
// zero energy of atoms not in group
// only do this after comm since ghost contributions must be included
int *mask = atom->mask;
for (i = 0; i < nlocal; i++)
if (!(mask[i] & groupbit)) energy[i] = 0.0;
}
/* ---------------------------------------------------------------------- */
int ComputeCNT_Et::pack_reverse_comm(int n, int first, double *buf)
{
int i,m,last;
m = 0;
last = first + n;
for (i = first; i < last; i++) buf[m++] = energy[i];
return m;
}
/* ---------------------------------------------------------------------- */
void ComputeCNT_Et::unpack_reverse_comm(int n, int *list, double *buf)
{
int i,j,m;
m = 0;
for (i = 0; i < n; i++) {
j = list[i];
energy[j] += buf[m++];
}
}
/* ----------------------------------------------------------------------
memory usage of local atom-based array
------------------------------------------------------------------------- */
double ComputeCNT_Et::memory_usage()
{
double bytes = nmax * sizeof(double);
return bytes;
}

View File

@ -0,0 +1,63 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef COMPUTE_CLASS
ComputeStyle(cnt/Et,ComputeCNT_Et)
#else
#ifndef LMP_COMPUTE_CNT_ET_ATOM_H
#define LMP_COMPUTE_CNT_ET_ATOM_H
#include "compute.h"
namespace LAMMPS_NS {
class ComputeCNT_Et : public Compute {
public:
ComputeCNT_Et(class LAMMPS *, int, char **);
~ComputeCNT_Et();
void init() {}
void compute_peratom();
int pack_reverse_comm(int, int, double *);
void unpack_reverse_comm(int, int *, double *);
double memory_usage();
private:
int nmax;
double *energy;
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: Illegal compute cnt/Et command
Incorrect argument list in the compute init.
E: Per-atom energy was not tallied on needed timestep
UNSPECIFIED.
E: cnt/Et is allowed only with cnt pair style
Use cnt pair style.
*/

View File

@ -0,0 +1,64 @@
/* -*- 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 "compute_cnt_Et_tot.h"
#include "pair_cnt_tpm.h"
#include <mpi.h>
#include <cstring>
#include "atom.h"
#include "update.h"
#include "force.h"
#include "bond.h"
#include "modify.h"
#include "domain.h"
#include "error.h"
#include <typeinfo>
using namespace LAMMPS_NS;
/* ---------------------------------------------------------------------- */
ComputeCNT_Et_tot::ComputeCNT_Et_tot(LAMMPS *lmp, int narg, char **arg) :
Compute(lmp, narg, arg)
{
if (narg < 3) error->all(FLERR,"Illegal compute cnt/Et_tot command");
if (igroup) error->all(FLERR,"Compute cnt/Et_tot must use group all");
timeflag = 1;
extscalar = 1;
scalar_flag = 1;
}
/* ---------------------------------------------------------------------- */
double ComputeCNT_Et_tot::compute_scalar()
{
invoked_scalar = update->ntimestep;
if (update->eflag_global != invoked_scalar)
error->all(FLERR,"Energy was not tallied on needed timestep");
double one = 0.0;
if (force->pair){
try {
PairCNTTPM* pair = dynamic_cast<PairCNTTPM*>(force->pair);
one += pair->energy_t;
}
catch (std::bad_cast& bc){
error->all(FLERR,"cnt/Et_tot is allowed only with cnt pair style");
}
}
MPI_Allreduce(&one,&scalar,1,MPI_DOUBLE,MPI_SUM,world);
return scalar;
}

View File

@ -0,0 +1,56 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef COMPUTE_CLASS
ComputeStyle(cnt/Et_tot,ComputeCNT_Et_tot)
#else
#ifndef LMP_COMPUTE_CNT_ET_H
#define LMP_COMPUTE_CNT_ET_H
#include "compute.h"
namespace LAMMPS_NS {
class ComputeCNT_Et_tot : public Compute {
public:
ComputeCNT_Et_tot(class LAMMPS *, int, char **);
~ComputeCNT_Et_tot() {}
void init() {}
double compute_scalar();
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: Illegal compute cnt/Et_tot command
Incorrect argument list in the compute init.
E: Compute cnt/Et_tot must use group all
UNSPECIFIED.
E: cnt/Et_tot is allowed only with cnt pair style
Use cnt pair style.
*/

48
src/USER-CNT/export_cnt.h Normal file
View File

@ -0,0 +1,48 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef __cplusplus
extern "C" {
#endif
// see ExportCNT.f90 in lib/cnt for function details
void TPBInit();
void TPMInit(const int& M, const int& N);
void SetTablePath(const char* TPMSSTPFile, const int& N1,
const char* TPMAFile, const int& N2);
void InitCNTPotModule(const int& STRModel, const int& STRParams,
const int& YMType, const int& BNDModel, const double& Rref);
double get_R();
void TubeStretchingForceField(double& U1, double& U2, double* F1,
double* F2, double* S1, double* S2, const double* X1, const double* X2,
const double& R12, const double& L12);
void TubeBendingForceField(double& U1, double& U2, double& U3, double* F1,
double* F2, double* F3, double* S1, double* S2, double* S3,
const double* X1, const double* X2, const double* X3, const double& R123,
const double& L123, int& BBF2 );
void SegmentTubeForceField(double& U1, double& U2, double *U, double* F1,
double* F2, double* F, double* Fe, double* S1, double* S2, double* S,
double* Se, const double* X1, const double* X2, const double& R12,
const int& N, const double* X, const double* Xe, const int* BBF,
const double& R, const int& E1, const int& E2, const int& Ee,
const int& TPMType);
#ifdef __cplusplus
}
#endif

View File

@ -0,0 +1,497 @@
/* -*- 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 "pair_cnt_tpm.h"
#include "cntlist.h"
#include "export_cnt.h"
#include <mpi.h>
#include "atom.h"
#include "comm.h"
#include "force.h"
#include "memory.h"
#include "error.h"
#include "neighbor.h"
#include "neigh_list.h"
#include "neigh_request.h"
#include <cstring>
#include <iostream>
#include <vector>
#include <cmath>
#include <string>
#include <fstream>
using namespace LAMMPS_NS;
// the cutoff distance between walls of tubes
static const double TPBRcutoff = 3.0*3.4;
/* ---------------------------------------------------------------------- */
PairCNTTPM::PairCNTTPM(LAMMPS *lmp) : Pair(lmp) {
writedata=1;
BendingMode = 0; // Harmonic bending model
TPMType = 0; // Inter-tube segment-segment interaction
tab_path = NULL;
tab_path_length = 0;
eatom_s = NULL;
eatom_b = NULL;
eatom_t = NULL;
}
/* ---------------------------------------------------------------------- */
PairCNTTPM::~PairCNTTPM()
{
if (allocated) {
memory->destroy(setflag);
memory->destroy(cutsq);
memory->destroy(cut);
memory->destroy(eatom_s);
memory->destroy(eatom_b);
memory->destroy(eatom_t);
}
if (tab_path != NULL) memory->destroy(tab_path);
}
/* ---------------------------------------------------------------------- */
void PairCNTTPM::compute(int eflag, int vflag){
int nlocal = atom->nlocal; //number of local atoms at the node
//total number of atoms in the node and ghost shell
int nall = nlocal + atom->nghost;
int newton_pair = force->newton_pair; //check "newton command"
if(!newton_pair) error->all(FLERR,"set newton_pair");
double **x = atom->x;
double **f = atom->f;
double *r = atom->radius;
double *m = atom->rmass;
double *l = atom->length;
int *buckling = atom->buckling;
tagint *g_id = atom->tag;
tagint **bonds = atom->bond_cnt;
//generate bonds and chain nblist
CNTList cntlist(atom, list, cut_global*cut_global);
//reorder data to make it contiguous within tubes
//and compatable with Fortran functions
std::vector<double> x_sort(3*nall), f_sort(3*nall), s_sort(9*nall);
std::vector<double> u_ts_sort(nall), u_tb_sort(nall), u_tt_sort(nall);
std::vector<int> b_sort(nall);
for (int i = 0; i < nall; i++){
int idx = cntlist.get_idx(i);
for (int j = 0; j < 3; j++) x_sort[3*i+j] = x[idx][j];
b_sort[i] = buckling[idx];
}
//bending potential
int n_triplets = cntlist.get_triplets().size();
for (int i = 0; i < n_triplets; i++) {
const array2003<int,3>& t = cntlist.get_triplets()[i];
//idx of nodes of a triplet in sorted representation
int idx_s0 = cntlist.get_idxb(t[0]);
int idx_s1 = cntlist.get_idxb(t[1]);
int idx_s2 = cntlist.get_idxb(t[2]);
double* X1 = &(x_sort[3*idx_s0]);
double* X2 = &(x_sort[3*idx_s1]);
double* X3 = &(x_sort[3*idx_s2]);
double& U1b = u_tb_sort[idx_s0];
double& U2b = u_tb_sort[idx_s1];
double& U3b = u_tb_sort[idx_s2];
double* F1 = &(f_sort[3*idx_s0]);
double* F2 = &(f_sort[3*idx_s1]);
double* F3 = &(f_sort[3*idx_s2]);
double* S1 = &(s_sort[9*idx_s0]);
double* S2 = &(s_sort[9*idx_s1]);
double* S3 = &(s_sort[9*idx_s2]);
double& R123 = r[t[1]];
double& L123 = l[t[1]];
int& BBF2 = b_sort[idx_s1];
TubeBendingForceField(U1b, U2b, U3b, F1, F2, F3, S1, S2, S3, X1, X2, X3,
R123, L123, BBF2);
}
//segment-segment and segment-tube interactions
int n_segments = cntlist.get_segments().size();
double Lmax = 0.0, Rmax = 0.0;
double RT = get_R();
for (int i = 0; i < n_segments; i++) {
const array2003<int,2>& s = cntlist.get_segments()[i];
//idx of a segment end 1 in sorted representation
int idx_s0 = cntlist.get_idxb(s[0]);
//idx of a segment end 2 in sorted representation
int idx_s1 = cntlist.get_idxb(s[1]);
double* X1 = &(x_sort[3*idx_s0]);
double* X2 = &(x_sort[3*idx_s1]);
double length = std::sqrt(std::pow(X1[0]-X2[0],2) +
std::pow(X1[1]-X2[1],2) + std::pow(X1[2]-X2[2],2));
if (length > Lmax) Lmax = length;
double& U1t = u_tt_sort[idx_s0];
double& U2t = u_tt_sort[idx_s1];
double& U1s = u_ts_sort[idx_s0];
double& U2s = u_ts_sort[idx_s1];
double* F1 = &(f_sort[3*idx_s0]);
double* F2 = &(f_sort[3*idx_s1]);
double* S1 = &(s_sort[9*idx_s0]);
double* S2 = &(s_sort[9*idx_s1]);
double R12 = r[s[0]]; if (R12 > Rmax) Rmax = R12;
if (std::abs(R12 - RT) > 1e-3)
error->all(FLERR,"Inconsistent input and potential table");
//assume that the length of the segment is defined by the node with
//smallest global id
double L12 = (g_id[s[0]] > g_id[s[1]]) ? l[s[1]] : l[s[0]];
TubeStretchingForceField(U1s, U2s, F1, F2, S1, S2, X1, X2, R12, L12);
for (int nc = 0; nc < cntlist.get_nbs()[i].size(); nc++){
//id of the beginning and end of the chain in the sorted representation
const array2003<int,2>& chain = cntlist.get_nbs()[i][nc];
int N = chain[1] - chain[0] + 1; //number of elements in the chain
int end1 = cntlist.get_idx(chain[0]); //chain ends (real representation)
int end2 = cntlist.get_idx(chain[1]);
double* X = &(x_sort[3*chain[0]]);
double* Ut = &(u_tt_sort[chain[0]]);
double* Us = &(u_ts_sort[chain[0]]);
double* F = &(f_sort[3*chain[0]]);
double* S = &(s_sort[9*chain[0]]);
double R = r[end1];
int* BBF = &(b_sort[chain[0]]);
int E1 = cntlist.is_end(end1);
int E2 = cntlist.is_end(end2);
int Ee = 0;
double* Xe = X; double* Fe = F; double* Se = S;
if (!E1 && cntlist.get_triplet(end1)[0] != CNTList::domain_end &&
cntlist.get_triplet(cntlist.get_triplet(end1)[0])[0] ==
CNTList::cnt_end){
Ee = 1;
int idx = cntlist.get_idxb(cntlist.get_triplet(end1)[0]);
Xe = &(x_sort[3*idx]);
Fe = &(f_sort[3*idx]);
Se = &(s_sort[9*idx]);
}
else if (!E2 && cntlist.get_triplet(end2)[2] != CNTList::domain_end &&
cntlist.get_triplet(cntlist.get_triplet(end2)[2])[2] ==
CNTList::cnt_end){
Ee = 2;
int idx = cntlist.get_idxb(cntlist.get_triplet(end2)[2]);
Xe = &(x_sort[3*idx]);
Fe = &(f_sort[3*idx]);
Se = &(s_sort[9*idx]);
}
SegmentTubeForceField(U1t, U2t, Ut, F1, F2, F, Fe, S1, S2, S, Se, X1,
X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType);
}
}
if(neighbor->old_nrequest > 0){ //check if cutoff is chosen correctly
double Rcut_min = std::max(2.0*Lmax, std::sqrt(0.5*Lmax*Lmax +
std::pow((2.0*Rmax + TPBRcutoff),2)));
if (cut_global < Rcut_min){
std::cout << "L_max: = " << Lmax << ", R_max = " << Rmax << ", Rc = "
<< cut_global << ", Rcut_min = " << Rcut_min << std::endl;
error->all(FLERR,"The selected cutoff is too small for the current system");
}
}
// set per atom values and accumulators
// reallocate per-atom arrays if necessary
if (atom->nmax > maxeatom) {
maxeatom = atom->nmax;
memory->destroy(eatom);
memory->create(eatom,comm->nthreads*maxeatom,"pair:eatom");
memory->destroy(eatom_s);
memory->create(eatom_s,comm->nthreads*maxeatom,"pair:eatom_s");
memory->destroy(eatom_b);
memory->create(eatom_b,comm->nthreads*maxeatom,"pair:eatom_b");
memory->destroy(eatom_t);
memory->create(eatom_t,comm->nthreads*maxeatom,"pair:eatom_t");
}
if (atom->nmax > maxvatom) {
maxvatom = atom->nmax;
memory->destroy(vatom);
memory->create(vatom,comm->nthreads*maxvatom,6,"pair:vatom");
}
// zero accumulators
eng_vdwl = 0.0; energy_s = 0.0;
energy_b = 0.0; energy_t = 0.0;
for (int i = 0; i < 6; i++) virial[i] = 0.0;
for (int i = 0; i < nall; i++){
eatom[i] = 0.0; eatom_s[i] = 0.0;
eatom_b[i] = 0.0; eatom_t[i] = 0.0;
}
for (int i = 0; i < nall; i++)
for (int j = 0; j < 6; j++) vatom[i][j] = 0.0;
//convert from sorted representation
for (int i = 0; i < nall; i++){
int idx = cntlist.get_idx(i);
for (int j = 0; j < 3; j++) f[idx][j] = f_sort[3*i+j];
eatom_s[idx] = u_ts_sort[i];
eatom_b[idx] = u_tb_sort[i];
eatom_t[idx] = u_tt_sort[i];
eatom[idx] = u_ts_sort[i] + u_tb_sort[i] + u_tt_sort[i];
energy_s += u_ts_sort[i];
energy_b += u_tb_sort[i];
energy_t += u_tt_sort[i];
vatom[idx][0] = s_sort[9*i+0]; //xx
vatom[idx][1] = s_sort[9*i+4]; //yy
vatom[idx][2] = s_sort[9*i+8]; //zz
vatom[idx][3] = s_sort[9*i+1]; //xy
vatom[idx][4] = s_sort[9*i+2]; //xz
vatom[idx][5] = s_sort[9*i+5]; //yz
for (int j = 0; j < 6; j++) virial[j] += vatom[idx][j];
buckling[idx] = b_sort[i];
}
eng_vdwl = energy_s + energy_b + energy_t;
}
/* ----------------------------------------------------------------------
allocate all arrays
------------------------------------------------------------------------- */
void PairCNTTPM::allocate(){
allocated = 1;
int n = atom->ntypes;
memory->create(setflag,n+1,n+1,"pair:setflag");
for (int i = 1; i <= n; i++)
for (int j = i; j <= n; j++)
setflag[i][j] = 0;
memory->create(cutsq,n+1,n+1,"pair:cutsq");
memory->create(cut,n+1,n+1,"pair:cut");
}
/* ----------------------------------------------------------------------
global settings
------------------------------------------------------------------------- */
void PairCNTTPM::settings(int narg, char **arg){
if ((narg == 0) || (narg > 4))
error->all(FLERR,"Illegal pair_style command");
cut_global = force->numeric(FLERR,arg[0]);
// reset cutoffs that have been explicitly set
if (allocated) {
int i,j;
for (i = 1; i <= atom->ntypes; i++)
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";
SetTablePath(TPMSSTPFile.c_str(), TPMSSTPFile.length(), TPMAFile.c_str(),
TPMAFile.length());
}
else TPMAFile = "TPMA.xrs";
if (narg > 2) {
BendingMode = force->numeric(FLERR,arg[2]);
if ((BendingMode < 0) || (BendingMode > 1))
error->all(FLERR,"Incorrect BendingMode");
}
if (narg > 3){
TPMType = force->numeric(FLERR,arg[3]);
if ((TPMType < 0) || (TPMType > 1))
error->all(FLERR,"Incorrect TPMType");
}
TPBInit();
int M, N;
std::ifstream in(TPMAFile);
if (!in.is_open()) error->all(FLERR,"Incorrect table path");
in >> M >> N;
in.close();
TPMInit(M, N);
InitCNTPotModule(1, 3, 0, BendingMode, get_R());
}
/* ----------------------------------------------------------------------
set coeffs for one or more type pairs
------------------------------------------------------------------------- */
void PairCNTTPM::coeff(int narg, char **arg){
if ((narg < 2) || (narg > 3))
error->all(FLERR,"Incorrect args for pair coefficients");
if (!allocated) allocate();
int ilo,ihi,jlo,jhi;
force->bounds(FLERR,arg[0],atom->ntypes,ilo,ihi);
force->bounds(FLERR,arg[1],atom->ntypes,jlo,jhi);
double cut_one = cut_global;
if (narg == 3) cut_one = force->numeric(FLERR,arg[2]);
int count = 0;
for (int i = ilo; i <= ihi; i++) {
for (int j = MAX(jlo,i); j <= jhi; j++) {
cut[i][j] = cut_one;
setflag[i][j] = 1;
count++;
}
}
if (count == 0) error->all(FLERR,"Incorrect args for pair coefficients");
}
/* ----------------------------------------------------------------------
init for one type pair i,j and corresponding j,i
------------------------------------------------------------------------- */
double PairCNTTPM::init_one(int i, int j){
if (setflag[i][j] == 0) {
cut[i][j] = mix_distance(cut[i][i],cut[j][j]);
}
return cut[i][j];
}
/* ----------------------------------------------------------------------
proc 0 writes to restart file
------------------------------------------------------------------------- */
void PairCNTTPM::write_restart(FILE *fp){
write_restart_settings(fp);
int i,j;
for (i = 1; i <= atom->ntypes; i++)
for (j = i; j <= atom->ntypes; j++) {
fwrite(&setflag[i][j],sizeof(int),1,fp);
if (setflag[i][j]) {
fwrite(&cut[i][j],sizeof(double),1,fp);
}
}
}
/* ----------------------------------------------------------------------
proc 0 reads from restart file, bcasts
------------------------------------------------------------------------- */
void PairCNTTPM::read_restart(FILE *fp){
read_restart_settings(fp);
allocate();
int i,j;
int me = comm->me;
for (i = 1; i <= atom->ntypes; i++)
for (j = i; j <= atom->ntypes; j++) {
if (me == 0) fread(&setflag[i][j],sizeof(int),1,fp);
MPI_Bcast(&setflag[i][j],1,MPI_INT,0,world);
if (setflag[i][j]) {
if (me == 0) {
fread(&cut[i][j],sizeof(double),1,fp);
}
MPI_Bcast(&cut[i][j],1,MPI_DOUBLE,0,world);
}
}
}
/* ----------------------------------------------------------------------
proc 0 writes to restart file
------------------------------------------------------------------------- */
void PairCNTTPM::write_restart_settings(FILE *fp){
fwrite(&BendingMode,sizeof(int),1,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);
}
/* ----------------------------------------------------------------------
proc 0 reads from restart file, bcasts
------------------------------------------------------------------------- */
void PairCNTTPM::read_restart_settings(FILE *fp){
int me = comm->me;
if (me == 0) {
fread(&BendingMode,sizeof(int),1,fp);
fread(&TPMType,sizeof(int),1,fp);
fread(&cut_global,sizeof(double),1,fp);
fread(&tab_path_length,sizeof(int),1,fp);
}
MPI_Bcast(&BendingMode,1,MPI_INT,0,world);
MPI_Bcast(&TPMType,1,MPI_INT,0,world);
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";
SetTablePath(TPMSSTPFile.c_str(), TPMSSTPFile.length(), TPMAFile.c_str(),
TPMAFile.length());
}
std::string TPMAFile = std::string((tab_path == NULL) ? "" : tab_path)
+ "TPMA.xrs";
TPBInit();
int M, N;
std::ifstream in(TPMAFile);
if (!in.is_open()) error->all(FLERR,"Incorrect table path");
in >> M >> N;
in.close();
TPMInit(M, N);
InitCNTPotModule(1, 3, 0, BendingMode, get_R());
}
/* ----------------------------------------------------------------------
proc 0 writes to data file
------------------------------------------------------------------------- */
void PairCNTTPM::write_data(FILE *fp){
for (int i = 1; i <= atom->ntypes; i++)
fprintf(fp,"%d\n",i);
}
/* ----------------------------------------------------------------------
proc 0 writes all pairs to data file
------------------------------------------------------------------------- */
void PairCNTTPM::write_data_all(FILE *fp){
for (int i = 1; i <= atom->ntypes; i++)
for (int j = i; j <= atom->ntypes; j++)
fprintf(fp,"%d %d %g\n",i,j,cut[i][j]);
}
/* ---------------------------------------------------------------------- */
void PairCNTTPM::init_style(){
//make sure that a full list is created (including ghost nodes)
int r = neighbor->request(this,instance_me);
neighbor->requests[r]->half = false;
neighbor->requests[r]->full = true;
neighbor->requests[r]->ghost = true;
}

View File

@ -0,0 +1,97 @@
/* -*- 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
------------------------------------------------------------------------- */
#ifdef PAIR_CLASS
PairStyle(cnt/tpm,PairCNTTPM)
#else
#ifndef LMP_PAIR_CNT_TPM_H
#define LMP_PAIR_CNT_TPM_H
#include "pair.h"
namespace LAMMPS_NS {
class PairCNTTPM : public Pair {
public:
PairCNTTPM(class LAMMPS *);
virtual ~PairCNTTPM();
virtual void compute(int, int);
void settings(int, char **);
void coeff(int, char **);
double init_one(int, int);
void write_restart(FILE *);
void read_restart(FILE *);
void write_restart_settings(FILE *);
void read_restart_settings(FILE *);
void write_data(FILE *);
void write_data_all(FILE *);
virtual void init_style();
double energy_s; // accumulated energies for stretching
double energy_b; // accumulated energies for bending
double energy_t; // accumulated energies for tube-tube interaction
double *eatom_s, *eatom_b, *eatom_t; // accumulated per-atom values
protected:
int BendingMode, TPMType;
char* tab_path;
int tab_path_length;
double cut_global;
double **cut;
virtual void allocate();
};
}
#endif
#endif
/* ERROR/WARNING messages:
E: set newton_pair
newton_pair must be set to true
E: The selected cutoff is too small for the current system
cutoff must be increased.
E: Illegal pair_style command
Incorrect argument list in the style init.
E: Incorrect table path
Incorrect path to the table files.
E: Incorrect BendingMode
Self-explanatory.
E: Incorrect TPMType
Self-explanatory.
E: Inconsistent input and potential table
The tube diameter is inconsistent with the chirality specified
during generation of the potential table.
*/

View File

@ -108,6 +108,12 @@ Atom::Atom(LAMMPS *lmp) : Pointers(lmp)
cc = cc_flux = NULL;
edpd_temp = edpd_flux = edpd_cv = NULL;
// USER-CNT package
length = NULL;
buckling = NULL;
bond_cnt = NULL;
// USER-SMD
contact_radius = NULL;
@ -367,6 +373,11 @@ Atom::~Atom()
for (int i = 0; i < nmolecule; i++) delete molecules[i];
memory->sfree(molecules);
// USER-CNT package
memory->destroy(length);
memory->destroy(buckling);
memory->destroy(bond_cnt);
// delete per-type arrays
@ -2284,6 +2295,11 @@ void *Atom::extract(char *name)
if (strcmp(name,"dpdTheta") == 0) return (void *) dpdTheta;
if (strcmp(name,"edpd_temp") == 0) return (void *) edpd_temp;
// USER-CNT package
if (strcmp(name,"length") == 0) return (void *) length;
if (strcmp(name,"buckling") == 0) return (void *) buckling;
if (strcmp(name,"bond_cnt") == 0) return (void *) bond_cnt;
return NULL;
}

View File

@ -111,6 +111,11 @@ class Atom : protected Pointers {
double *edpd_cv; // heat capacity
int cc_species;
// USER-CNT package
double *length;
int *buckling;
tagint **bond_cnt;
// molecular info
int **nspecial; // 0,1,2 = cumulative # of 1-2,1-3,1-4 neighs

58
tools/cnt/README Normal file
View File

@ -0,0 +1,58 @@
=== CNT tools ===
===============================
The programs in this folder can be used to analyze the
output of simulations using the CNT mesoscopic force
field (USER-CN).
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\cnt)
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.
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.
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/cnt/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/cnt/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 !********************************************************************************

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

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 !*******************************************************************************

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 !*****************************************************************************

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

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, 2020, Version 13.00
!
!***************************************************************************************************
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 coortinates of the point accorning to periodic boundary conditions
! it order to makesure that the point is inside the computational cell
!-------------------------------------------------------------------------------------------
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 )
!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 neares 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, displacemets
! 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 !********************************************************************************

205
tools/cnt/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 !*********************************************************************************

View File

@ -0,0 +1,98 @@
module LinFun2 !************************************************************************************
!
! TMD Library: Bi-linear functions and their derivatives
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
implicit none
contains !******************************************************************************************
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) )
A = 1.0d+00 - A0
CalcLinFun1_0 = A0 * F(i1) + A * F(i)
end function CalcLinFun1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcLinFun1_1 ( S, Sx1, i, X, N, P, F, Fx ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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) )
A = 1.0d+00 - A0
S = A0 * F(i1) + A * F(i)
Sx1 = A0 * Fx(i1) + A * Fx(i)
end subroutine CalcLinFun1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
A0 = ( P1(i) - X ) / ( P1(i) - P1(i1) )
A = 1.0d+00 - A0
B0 = ( P2(j) - Y ) / ( P2(j) - P2(j1) )
B = 1.0d+00 - B0
G = B0 * F(i,j1) + B * F(i,j)
G0 = B0 * F(i1,j1) + B * F(i1,j)
CalcLinFun2_0 = A0 * G0 + A * G
end function CalcLinFun2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcLinFun2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fx, Fy ) !!!!!!!!!!!!
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
A0 = ( P1(i) - X ) / ( P1(i) - P1(i1) )
A = 1.0d+00 - A0
B0 = ( P2(j) - Y ) / ( P2(j) - P2(j1) )
B = 1.0d+00 - B0
G = B0 * F(i,j1) + B * F(i,j)
G0 = B0 * F(i1,j1) + B * F(i1,j)
S = A0 * G0 + A * G
G = B0 * Fx(i,j1) + B * Fx(i,j)
G0 = B0 * Fx(i1,j1) + B * Fx(i1,j)
Sx1 = A0 * G0 + A * G
G = B0 * Fy(i,j1) + B * Fy(i,j)
G0 = B0 * Fy(i1,j1) + B * Fy(i1,j)
Sy1 = A0 * G0 + A * G
end subroutine CalcLinFun2_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module LinFun2 !********************************************************************************

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

View File

@ -0,0 +1,178 @@
module Spline1 !************************************************************************************
!
! TMD Library: One-dimensional cubic spline function
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
implicit none
contains !******************************************************************************************
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
end function ValueSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine ValueSpline1_1 ( S, S1, X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!
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
HL = X - Xi_1
HR = Xi - X
HL2 = HL * HL
HR2 = HR * HR
S = ( ( Mi_1 * HR2 * Hr + Mi * HL2 * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * HR + ( Yi - Mi * H26 ) * HL ) / Hi_1
S1 = ( ( Mi * HL2 - Mi_1 * HR2 ) / 2.0d+00 + Yi - Yi_1 ) / Hi_1 - H6 * ( Mi - Mi_1 )
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*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)
do i = 1, N - 1
D = - ( K1(i) + F(i-1) * K0(i) )
X(i) = ( K0(i) * X(i-1) - F(i) ) / D
F(i) = K2(i) / D
end do
do i = N - 2, 0, -1
X(i) = X(i) + F(i) * X(i+1)
end do
end subroutine sprogonka3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CreateSpline1 ( CL, CR, N, P, F, M, D, K0, K1, K2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
K1(i) = ( F(i) - F(i-1) ) / K0(i)
end do
select case ( CL )
case (1)
K1(0) = 2.0d+00 / 3.0d+00
K2(0) = 1.0d+00 / 3.0d+00
D (0) = 2 * ( K1(1) - M(0) ) / K0(1)
case (2)
K1(0) = 1.0d+00
K2(0) = 0.0d+00
D(0) = M(0)
case (3)
K1(0) = 1.0d+00
K2(0) = 0.0d+00
D(0) = 0.0d+00
end select
Z = K1(N-1)
do i = 1, N - 2
D(i) = 6.0d+00 * ( K1(i+1) - K1(i) )
K2(i) = K0(i+1)
K1(i) = 2.0d+00 * ( K2(i) + K0(i) )
end do
select case ( CR )
case (1)
D(N-1) = 2.0d+00 * ( M(N-1) - Z ) / K0(N-1)
K1(N-1) = 2.0d+00 / 3.0d+00
K0(N-1) = 1.0d+00 / 3.0d+00
case (2)
K1(N-1) = 1.0d+00
K0(N-1) = 0.0d+00
D(N-1) = M(N-1)
case (3)
K1(N-1) = 1.0d+00
K0(N-1) = 0.0d+00
D(N-1) = 0.0d+00
end select
call sprogonka3 ( N, K0, K1, K2, D, M )
end subroutine CreateSpline1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
HR = P(i) - X
H = P(i) - P(j)
H6 = H / 6.0d+00
H26 = H * H6
HL2 = HL * HL
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
end function CalcSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_1 ( S, S1, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
HR = P(i) - X
H = P(i) - P(j)
H6 = H / 6.0d+00
H26 = H * H6
HL2 = HL * HL
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) )
end subroutine CalcSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline1_2 ( S, S1, S2, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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)
HR = P(i) - X
H = P(i) - P(j)
H6 = H / 6.0d+00
H26 = H * H6
HL2 = HL * HL
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
end subroutine CalcSpline1_2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module Spline1 !********************************************************************************

View File

@ -0,0 +1,171 @@
module Spline2 !************************************************************************************
!
! TMD Library: Two-dimensional cubic spline function
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017
!
!***************************************************************************************************
use Spline1
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*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)
MM(0) = Fxx(0,II)
MM(N1-1) = Fxx(N1-1,II)
call CreateSpline1 ( CL, CR, N1, P1, FF, MM, DD, K0, K1, K2 )
Fxx(0:N1-1,II) = MM(0:N1-1)
end do
do II = 0, N1 - 1
MM(0) = Fyy(II,0)
MM(N-1) = Fyy(II,N2-1)
FF(0:N2-1) = F(II,0:N2-1)
call CreateSpline1 ( CD, CU, N2, P2, FF, MM, DD, K0, K1, K2 )
Fyy(II,0:N2-1) = MM(0:N2-1)
end do
FF(0:N1-1) = Fyy(0:N1-1,0 )
call CreateSpline1 ( 3, 3, N1, P1, FF, MM, DD, K0, K1, K2 )
Fxxyy(0:N1-1,0) = MM(0:N1-1)
FF(0:N1-1) = Fyy(0:N1-1,N2-1 )
call CreateSpline1 ( 3, 3, N1, P1, FF, MM, DD, K0, K1, k2 )
Fxxyy(0:N1-1,N2-1) = MM(0:N1-1)
do II = 1, N1 - 2
MM(0) = Fxxyy(II,0)
MM(N-1) = Fxxyy(II,N2-1)
FF(0:N2-1) = Fxx(II,0:N2-1)
call CreateSpline1 ( 2 , 2, N2, P2, FF, MM, DD, K0, K1, K2 )
Fxxyy(II,0:N2-1) = MM(0:N2-1)
end do
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*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
Fxxyy = 0.0d+00
do II = 0, N2A
FF(0:N1-1) = F(0:N1-1,II)
MM(0) = Fxx(0,II)
MM(N1-1) = Fxx(N1-1,II)
call CreateSpline1 ( CL, CR, N1, P1, FF, MM, DD, K0, K1, K2 )
Fxx(0:N1-1,II) = MM(0:N1-1)
end do
do II = N2A + 1, N2 - 1
FF(0:N1-N1A-1) = F(N1A:N1-1,II)
MM(0) = Fxx(N1A,II)
MM(N1-N1A-1) = Fxx(N1-1,II)
call CreateSpline1 ( CL, CR, N1 - N1A, P1, FF, MM, DD, K0, K1, K2 )
Fxx(N1A:N1-1,II) = MM(0:N1-N1A-1)
end do
do II = 0, N1A - 1
MM(0) = Fyy(II,0)
MM(N2A) = Fyy(II,N2A)
FF(0:N2A) = F(II,0:N2A)
call CreateSpline1 ( CD, CU, N2A + 1, P2, FF, MM, DD, K0, K1, K2 )
Fyy(II,0:N2A) = MM(0:N2A)
end do
do II = N1A, N1 - 1
MM(0) = Fyy(II,0)
MM(N-1) = Fyy(II,N2-1)
FF(0:N2-1) = F(II,0:N2-1)
call CreateSpline1 ( CD, CU, N2, P2, FF, MM, DD, K0, K1, K2 )
Fyy(II,0:N2-1) = MM(0:N2-1)
end do
FF(0:N1-1) = Fyy(0:N1-1,0)
call CreateSpline1 ( 3, 3, N1, P1, FF, MM, DD, K0, K1, K2 )
Fxxyy(0:N1-1,0) = MM(0:N1-1)
FF(0:N1A) = Fyy(0:N1A,N2A)
call CreateSpline1 ( 3, 3, N1A + 1, P1, FF, MM, DD, K0, K1, K2 )
Fxxyy(0:N1A,N2A) = MM(0:N1A)
FF(0:N1-N1A-1) = Fyy(N1A:N1-1,N2-1 )
call CreateSpline1 ( 3, 3, N1-N1A, P1, FF, MM, DD, K0, K1, K2 )
Fxxyy(N1A:N1-1,N2-1) = MM(0:N1-N1A-1)
do II = 1, N1A
MM(0) = Fxxyy(II,0)
MM(N2A) = Fxxyy(II,N2A)
FF(0:N2A) = Fxx(II,0:N2A)
call CreateSpline1 ( 2 , 2, N2A + 1, P2, FF, MM, DD, K0, K1, K2 )
Fxxyy(II,0:N2A) = MM(0:N2A)
end do
do II = N1A + 1, N1 - 2
MM(0) = Fxxyy(II,0)
MM(N-1) = Fxxyy(II,N2-1)
FF(0:N2-1) = Fxx(II,0:N2-1)
call CreateSpline1 ( 2 , 2, N2, P2, FF, MM, DD, K0, K1, K2 )
Fxxyy(II,0:N2-1) = MM(0:N2-1)
end do
end subroutine CreateSpline2Ext !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
T = P2(j) - P2(j1)
Gy_0 = ValueSpline1_0 ( Y, P2(j), P2(j1), F(i,j), F(i,j1), Fyy(i,j), Fyy(i,j1), T )
Gy_1 = ValueSpline1_0 ( Y, P2(j), P2(j1), F(i1,j), F(i1,j1), Fyy(i1,j), Fyy(i1,j1), T )
Gxxy_0 = ValueSpline1_0 ( Y, P2(j), P2(j1), Fxx(i,j), Fxx(i,j1), Fxxyy(i,j), Fxxyy(i,j1), T )
Gxxy_1 = ValueSpline1_0 ( Y, P2(j), P2(j1), Fxx(i1,j), Fxx(i1,j1), Fxxyy(i1,j), Fxxyy(i1,j1), T )
CalcSpline2_0 = ValueSpline1_0 ( X, P1(i), P1(i1), Gy_0, Gy_1,Gxxy_0, Gxxy_1, P1(i) - P1(i1) )
end function CalcSpline2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine CalcSpline2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!
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
T = P2(j) - P2(j1)
call ValueSpline1_1 ( Gy_0, Gyy_0, Y, P2(j), P2(j1), F(i,j), F(i,j1), Fyy(i,j), Fyy(i,j1), T )
call ValueSpline1_1 ( Gy_1, Gyy_1, Y, P2(j), P2(j1), F(i1,j), F(i1,j1), Fyy(i1,j), Fyy(i1,j1), T )
call ValueSpline1_1 ( Gxxy_0, Gxxyy_0, Y, P2(j), P2(j1), Fxx(i,j), Fxx(i,j1), Fxxyy(i,j), Fxxyy(i,j1), T )
call ValueSpline1_1 ( Gxxy_1, Gxxyy_1, Y, P2(j), P2(j1), Fxx(i1,j), Fxx(i1,j1), Fxxyy(i1,j), Fxxyy(i1,j1), T )
call ValueSpline1_1 ( S, Sx1, X, P1(i), P1(i1), Gy_0, Gy_1,Gxxy_0, Gxxy_1, P1(i) - P1(i1) )
Sy1 = ValueSpline1_0 ( X, P1(i), P1(i1), Gyy_0, Gyy_1,Gxxyy_0, Gxxyy_1, P1(i) - P1(i1) )
end subroutine CalcSpline2_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module Spline2 !********************************************************************************

View File

@ -0,0 +1,77 @@
program TMDPotGen !*********************************************************************************
!
! Stand-alone generator of tabulate files with tubular potential data for single-walled CNTs.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
!
!***************************************************************************************************
use TubePotMono
implicit none
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
integer*4 :: ChiIndM = 10 ! Chirality index m of nanotubes
integer*4 :: ChiIndN = 10 ! Chirality index n of nanotubes
! real*8 :: RT ! CNT radius (Angstrom)
!---------------------------------------------------------------------------------------------------
! Body
!---------------------------------------------------------------------------------------------------
! BC_X = 0
! BC_Y = 0
! BC_Z = 0
TPMStartMode = 0
! TPMNN = 100
! TPMHSwitch = 0
! TPMHS = 3.0d+00
! TPMASwitch = 0
! TPMAS = 3.0d+00
! Reading and printing of governing parameters
call LoadGoverningParameters ()
call PrintGoverningParameters ()
! Here we calculate the radius of nanotubes
! RT = TPBAcc * sqrt ( 3.0d+00 * ( ChiIndM * ChiIndM + ChiIndN * ChiIndN + ChiIndM * ChiIndN ) ) / M_2PI;
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 !*****************************************************************************

View File

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

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, 2020, Version 13.00
!
!***************************************************************************************************
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 coortinates of the point accorning to periodic boundary conditions
! it order to makesure that the point is inside the computational cell
!-------------------------------------------------------------------------------------------
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 )
!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 neares 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, displacemets
! 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 !********************************************************************************

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 !*********************************************************************************

View File

@ -0,0 +1,317 @@
module TubePotBase !********************************************************************************
!
! TMD Library: Non-Bonded pair interaction potential and transfer functions for atoms composing
! nanotubes.
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
!
!---------------------------------------------------------------------------------------------------
!
! This module contains basic parameters for all modules involved into calculations of tubular
! potentials.
!
! It includes definitions of
! -- TPBU, Lennard-Jones (12-6) potential
! -- TPBQ, Transfer function
!
! All default values are adjusted for non-bonded carbob-carbon interaction in carbon nanotubes.
!
!***************************************************************************************************
use TPMLib
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
! Types of the potential with respect to the breathing mode
integer*4, parameter :: TP_POT_MONO_R = 0
integer*4, parameter :: TP_POT_POLY_R = 1
! Maximal number of elements in corresponding tables
integer*4, parameter :: TPBNMAX = 2001
! Numerical constants
real*8, parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5
! Mass of C atom
real*8, parameter :: TPBMc = 12.0107d+00 ! (Da)
! Parameters of the Van der Waals inteaction between carbon atoms in graphene sheets, see
! Stuart S.J., Tutein A.B., Harrison J.A., J. Chem. Phys. 112(14), 2000
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
! Dresselhaus et al, Carbon 33(7), 1995
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*8, parameter :: TPBSHcc = 600.0d+00 / K_MDCU ! (eV/(Da*K))
! Cutoff distances for interactomic potential and transfer function
! Changes in these parameters can result in necessity to change some numerical parameters too.
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*8, parameter :: TPBQScc = TPBScc ! (A)
!real*8, parameter :: TPBQRcutoff1cc = 2.16d+00 * TPBScc ! (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 ()
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
real*8 :: TPBM = TPBMc ! Mass of an atom, Da
real*8 :: TPBE = TPBEcc ! Depth of the energy well in LJ (12-6) interatomic potential (eV)
real*8 :: TPBS = TPBScc ! Sigma parameter of LJ (12-6) 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*8 :: TPBRmin = TPBRmincc ! (A)
real*8 :: TPBRcutoff = TPBRcutoffcc ! (A)
real*8 :: TPBRcutoff1 = TPBRcutoff1cc ! (A)
! Physical parameters of the transfer function
real*8 :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A)
real*8 :: TPBQRcutoff1 = TPBQRcutoff1cc ! (A)
! Auxilary variables
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*4 :: TPBN = TPBNMAX
real*8 :: TPBDR
real*8, dimension(0:TPBNMAX-1) :: TPBQ
real*8, dimension(0:TPBNMAX-1) :: TPBU, TPBdUdR
contains !******************************************************************************************
integer*4 function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!TPBsizeof = sizeof ( TPBU ) + sizeof ( TPBdUdR )
TPBsizeof = 8 * ( size ( TPBQ ) + size ( TPBU ) + size ( TPBdUdR ) )
end function TPBsizeof !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Interpolation
!---------------------------------------------------------------------------------------------------
real*8 function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
!write ( TPErrMsg, '(a,e20.10,a,e20.10)' ) ': R < Rmin: R=', R, ', Rmin=', TPBRmin
!call Error ( 'TPBQInt0', TPErrMsg )
elseif ( R > TPBRcutoff ) then
TPBQInt0 = 0.0d+00
return
endif
RR = ( R - TPBRmin ) / TPBDR
i = int ( RR )
RR = RR - i
Z = 1.0d+00 - RR
TPBQInt0 = TPBQ(i) * Z + TPBQ(i+1) * RR
end function TPBQInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8 function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
!write ( TPErrMsg, '(a,e20.10,a,e20.10)' ) ': R < Rmin: R=', R, ', Rmin=', TPBRmin
!call Error ( 'TPBUInt0', TPErrMsg )
elseif ( R > TPBRcutoff ) then
TPBUInt0 = 0.0d+00
return
endif
RR = ( R - TPBRmin ) / TPBDR
i = int ( RR )
RR = RR - i
Z = 1.0d+00 - RR
TPBUInt0 = TPBU(i) * Z + TPBU(i+1) * RR
end function TPBUInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBUInt1 ( U, dUdR, R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(out) :: U, dUdR
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, RR
integer*4 :: i
!-------------------------------------------------------------------------------------------
if ( R < TPBRmin ) then
!call PrintStdLogMsg ( TPErrMsg )
!write ( TPErrMsg, '(a,e20.10,a,e20.10)' ) ': R < Rmin: R=', R, ', Rmin=', TPBRmin
!call Error ( 'TPBUInt1', TPErrMsg )
elseif ( R > TPBRcutoff ) then
TPBU = 0.0d+00
TPBdUdR = 0.0d+00
return
endif
RR = ( R - TPBRmin ) / TPBDR
i = int ( RR )
RR = RR - i
Z = 1.0d+00 - RR
U = TPBU(i) * Z + TPBU(i+1) * RR
dUdR = TPBdUdR(i) * Z + TPBdUdR(i+1) * RR
end subroutine TPBUInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Calculation
!---------------------------------------------------------------------------------------------------
real*8 function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, t, S
!-------------------------------------------------------------------------------------------
if ( R > TPBRcutoff ) then
TPBQCalc0 = 0.0d+00
else if ( R < TPBQR0 ) then
TPBQCalc0 = 1.0d+00
else
Z = TPBQS / R
Z = Z * Z * Z
Z = Z * Z
TPBQCalc0 = 4.0d+00 * ( 1.0d+00 - Z ) * Z
if ( R > TPBQRcutoff1 ) then
t = ( R - TPBQRcutoff1 ) / TPBQDRcutoff
S = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t )
TPBQCalc0 = TPBQCalc0 * S
endif
endif
end function TPBQCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8 function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R
!-------------------------------------------------------------------------------------------
real*8 :: Z, t, S
!-------------------------------------------------------------------------------------------
if ( R > TPBRcutoff ) then
TPBUCalc0 = 0.0d+00
else
Z = TPBS / R
Z = Z * Z * Z
Z = Z * Z
TPBUCalc0 = TPBE4 * ( Z - 1.0d+00 ) * Z
if ( R > TPBRcutoff1 ) then
t = ( R - TPBRcutoff1 ) / TPBDRcutoff
S = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t )
TPBUCalc0 = TPBUCalc0 * S
endif
endif
end function TPBUCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBUCalc1 ( U, dUdR, R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
dUdR = 0.0d+00
else
Z = TPBS / R
Z = Z * Z * Z
Z = Z * Z
U = TPBE4 * ( Z - 1.0d+00 ) * Z
dUdR = TPBE24 * ( 2.0d+00 * Z - 1.0d+00 ) * Z / R
if ( R > TPBRcutoff1 ) then
t = ( R - TPBRcutoff1 ) / TPBDRcutoff
S = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t )
dSdR = 6.0d+00 * t * ( t - 1.0d+00 ) / TPBDRcutoff
dUdR = dUdR * S + U * dSdR
U = U * S
endif
endif
end subroutine TPBUCalc1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPBSegmentForces ( F1, F2, F, M, Laxis, 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*8, dimension(0:2) :: FF, MM, FFF
!-------------------------------------------------------------------------------------------
FF = 0.5d+00 * F
MM = M / L
call V3_V3xxV3 ( FFF, MM, Laxis )
F1 = FF - FFF
F2 = FF + FFF
end subroutine TPBSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Printing
!---------------------------------------------------------------------------------------------------
! subroutine TPBPrint ( FileName ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! character*(*), intent(in) :: FileName
! !-------------------------------------------------------------------------------------------
! integer*4 :: Fuid
! integer*4 :: i
! real*8 :: 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*8 :: R
integer*4 :: i
!-------------------------------------------------------------------------------------------
TPBE4 = 4.0d+00 * TPBE
TPBE24 = - 24.0d+00 * TPBE
TPBDRcutoff = TPBRcutoff - TPBRcutoff1
TPBQDRcutoff = TPBRcutoff - TPBQRcutoff1
TPBQR0 = TPBQS * 2.0d+00 ** ( 1.0d+00 / 6.0d+00 )
TPBDR = ( TPBRcutoff - TPBRmin ) / ( TPBN - 1 )
R = TPBRmin
do i = 0, TPBN - 1
TPBQ(i) = TPBQCalc0 ( R )
call TPBUCalc1 ( TPBU(i), TPBdUdR(i), R )
R = R + TPBDR
enddo
end subroutine TPBInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TubePotBase !****************************************************************************

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,427 @@
module TubePotTrue !********************************************************************************
!
! TMD Library: True tubular potential and transfer function
!
!---------------------------------------------------------------------------------------------------
!
! Intel Fortran
!
! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00
!
!---------------------------------------------------------------------------------------------------
!
! This module implements calculation of true potential and transfer functions for interaction
! between two cylinder segments of nanotubes by direct integration over the surfaces of both
! segments.
!
!***************************************************************************************************
use TPMGeom
use TubePotBase
implicit none
!---------------------------------------------------------------------------------------------------
! Constants
!---------------------------------------------------------------------------------------------------
integer*4, parameter :: TPTNXMAX = 257
integer*4, parameter :: TPTNEMAX = 128
!---------------------------------------------------------------------------------------------------
! Types
!---------------------------------------------------------------------------------------------------
type TPTSEG !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Global variables
!---------------------------------------------------------------------------------------------------
type(TPTSEG) :: TPTSeg1, TPTSeg2 ! Two segments
contains !******************************************************************************************
subroutine TPTSegAxisVector ( S, Laxis ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
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*8, dimension(0:2), intent(out) :: Lrad
real*8, intent(in) :: Eps
!-------------------------------------------------------------------------------------------
real*8 :: Ce, Se
!-------------------------------------------------------------------------------------------
Ce = cos ( Eps )
Se = sin ( Eps )
Lrad(0) = Ce * S%M(0,0) + Se * S%M(1,0)
Lrad(1) = Ce * S%M(0,1) + Se * S%M(1,1)
Lrad(2) = Ce * S%M(0,2) + Se * S%M(1,2)
end subroutine TPTSegRadVector !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTRadiusVector ( S, R, X, Eps ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
real*8, dimension(0:2), intent(out) :: R
real*8, intent(in) :: X, Eps
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2) :: Laxis, Lrad
!-------------------------------------------------------------------------------------------
call TPTSegAxisVector ( S, Laxis )
call TPTSegRadVector ( S, Lrad, Eps )
R(0) = S%X + X * Laxis(0) + S%R * Lrad(0)
R(1) = S%Y + X * Laxis(1) + S%R * Lrad(1)
R(2) = S%Z + X * Laxis(2) + S%R * Lrad(2)
end subroutine TPTRadiusVector !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTCalcSegNodeTable ( S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
!-------------------------------------------------------------------------------------------
real*8 :: X, Eps
integer*4 :: i, j
!-------------------------------------------------------------------------------------------
X = - S%L / 2.0
call RotationMatrix3 ( S%M, S%Psi, S%Theta, S%Phi )
do i = 0, S%NX - 1
Eps = 0.0d+00
do j = 0, S%NE - 1
call TPTRadiusVector ( S, S%Rtab(i,j,0:2), X, Eps )
Eps = Eps + S%DE
end do
X = X + S%DX
end do
end subroutine TPTCalcSegNodeTable !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTSetSegPosition1 ( S, Rcenter, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
real*8, dimension(0:2), intent(in) :: Rcenter, Laxis
real*8, intent(in) :: L
!-------------------------------------------------------------------------------------------
S%L = L
S%DX = L / ( S%NX - 1 )
call EulerAngles ( S%Psi, S%Theta, Laxis )
S%Phi= 0.0d+00
S%X = Rcenter(0)
S%Y = Rcenter(1)
S%Z = Rcenter(2)
call TPTCalcSegNodeTable ( S )
end subroutine TPTSetSegPosition1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTSetSegPosition2 ( S, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(inout) :: S
real*8, dimension(0:2), intent(in) :: R1, R2
!-------------------------------------------------------------------------------------------
real*8, dimension(0:2) :: R, Laxis
real*8 :: L
!-------------------------------------------------------------------------------------------
R = 0.5 * ( R1 + R2 )
Laxis = R2 - R1
L = S_V3norm3 ( Laxis )
Laxis = Laxis / L
call TPTSetSegPosition1 ( S, R, Laxis, L )
end subroutine TPTSetSegPosition2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S1, S2
!-------------------------------------------------------------------------------------------
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
call TPTSegAxisVector ( S1, Laxis )
R(0) = S1%X
R(1) = S1%Y
R(2) = S1%Z
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) ) )
if ( Displacement > L1 .and. Displacement < L2 .and. D < S1%R ) then
TPTCheckIntersection = 1
return
end if
end do
end do
TPTCheckIntersection = 0
end function TPTCheckIntersection !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(TPTSEG), intent(in) :: S
real*8, intent(out) :: Xmin, Xmax
real*8, dimension(0:2), intent(in) :: Re
!-------------------------------------------------------------------------------------------
real*8 :: Displacement, Distance
real*8, dimension(0:2) :: Laxis, Q, R
!-------------------------------------------------------------------------------------------
call TPTSegAxisVector ( S, Laxis )
R(0) = S%X
R(1) = S%Y
R(2) = S%Z
call LinePoint ( Displacement, Q, R, Laxis, Re )
Distance = sqrt ( sqr ( Q(0) - Re(0) ) + sqr ( Q(1) - Re(1) ) + sqr ( Q(2) - Re(2) ) ) - S%R
if ( TPBRcutoff < Distance ) then
Xmin = 0.0d+00
Xmax = 0.0d+00
TPTCalcPointRange = 0
return
end if
Distance = sqrt ( TPBRcutoff * TPBRcutoff - Distance * Distance )
Xmin = Displacement - Distance
Xmax = Displacement + Distance
TPTCalcPointRange = 1
end function TPTCalcPointRange !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine TPTGetEnds ( R1_1, R1_2, R2_1, R2_2, 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
R1_1(2) = X1_1
R1_2(0) = 0.0d+00
R1_2(1) = 0.0d+00
R1_2(2) = X1_2
R2_1(0) = H
R2_1(1) = - X2_1 * sin ( A )
R2_1(2) = X2_1 * cos ( A )
R2_2(0) = H
R2_2(1) = - X2_2 * sin ( A )
R2_2(2) = X2_2 * cos ( A )
end subroutine TPTGetEnds !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Tubular potential
!---------------------------------------------------------------------------------------------------
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*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*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
U = 0.0d+00
F = 0.0d+00
if ( TPTCalcPointRange ( S, Xmin, Xmax, R ) == 0 ) return
X = - S%L / 2.0
do i = 0, S%NX - 1
if ( X > Xmin .and. X < Xmax ) then
QQ = 0.0d+00
UU = 0.0d+00
FF = 0.0d+00
do j = 0, S%NE - 1
RR(0:2) = S%Rtab(i,j,0:2) - R(0:2)
Rabs = S_V3norm3 ( RR )
if ( Rabs < TPBRcutoff ) then
QQ = QQ + TPBQCalc0 ( Rabs )
call TPBUCalc1 ( UUU, FFF, Rabs )
UU = UU + UUU
FFF = FFF / Rabs
FF = FF + FFF * RR
TPTPointPotential = 1
end if
end do
if ( i == 0 .or. i == S%NX - 1 ) then
Q = Q + 0.5d+00 * QQ
U = U + 0.5d+00 * UU
F = F + 0.5d+00 * FF
else
Q = Q + QQ
U = U + UU
F = F + FF
end if
end if
X = X + S%DX
end do
Coeff = TPBD * S%DX * S%R * S%DE
Q = Q * S%DX * S%R * S%DE
U = U * Coeff
F = F * Coeff
end function TPTPointPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer*4 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
! and applied to the i-th circular cross-section of the segment S.
!-------------------------------------------------------------------------------------------
real*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F, M
type(TPTSEG), intent(in) :: S, Ssource
integer*4, intent(in) :: i
!-------------------------------------------------------------------------------------------
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
U = 0.0d+00
F = 0.0d+00
M = 0.0d+00
Eps = 0.0d+00
do j = 0, S%NE - 1
call TPTSegRadVector ( S, Lrad, Eps )
if ( TPTPointPotential ( Qp, Up, Fp, S%Rtab(i,j,0:2), Ssource ) == 1 ) then
Q = Q + Qp
U = U + Up
F = F + Fp
R(0) = S%Rtab(i,j,0) - S%X
R(1) = S%Rtab(i,j,1) - S%Y
R(2) = S%Rtab(i,j,2) - S%Z
call V3_V3xxV3 ( Mp, R, Fp )
M = M + Mp
TPTSectionPotential = 1
end if
Eps = Eps + S%DE
end do
Coeff = TPBD * S%R * S%DE
Q = Q * S%R * S%DE
U = U * Coeff
F = F * Coeff
M = M * Coeff
end function TPTSectionPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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*8, intent(out) :: Q, U
real*8, dimension(0:2), intent(out) :: F, M
type(TPTSEG), intent(in) :: S, Ssource
integer*4 :: i
real*8, dimension(0:2) :: Fc, Mc
real*8 :: Qc, Uc
!-------------------------------------------------------------------------------------------
TPTSegmentPotential = 0
Q = 0.0d+00
U = 0.0d+00
F = 0.0d+00
M = 0.0d+00
if ( TPTCheckIntersection ( S, Ssource ) == 1 ) then
TPTSegmentPotential = 2
return
end if
do i = 0, S%NX - 1
if ( TPTSectionPotential ( Qc, Uc, Fc, Mc, S, i, Ssource ) == 1 ) then
if ( i == 0 .or. i == S%NX - 1 ) then
Q = Q + 0.5d+00 * Qc
U = U + 0.5d+00 * Uc
F = F + 0.5d+00 * Fc
M = M + 0.5d+00 * Mc
else
Q = Q + Qc
U = U + Uc
F = F + Fc
M = M + Mc
end if
TPTSegmentPotential = 1
end if
end do
Q = Q * S%DX
U = U * S%DX
F = F * S%DX
M = M * S%DX
end function TPTSegmentPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Forces
!---------------------------------------------------------------------------------------------------
subroutine TPTSegmentForces ( F1, F2, F, M, Laxis, 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*8, dimension(0:2) :: MM, FF, FFF
!-------------------------------------------------------------------------------------------
FF = 0.5d+00 * F
MM = M / L
call V3_V3xxV3 ( FFF, MM, Laxis )
F1 = FF - FFF
F2 = FF + FFF
end subroutine TPTSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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 appliend to the ends of segments.
!-------------------------------------------------------------------------------------------
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*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 )
Laxis1 = R1_2 - R1_1
Laxis2 = R2_2 - R2_1
L1 = S_V3norm3 ( Laxis1 )
L2 = S_V3norm3 ( Laxis2 )
Laxis1 = Laxis1 / L1
Laxis2 = Laxis2 / L2
DR = R2 - R1
call TPTSetSegPosition1 ( TPTSeg1, R1, Laxis1, L1 )
call TPTSetSegPosition1 ( TPTSeg2, R2, Laxis2, L2 )
TPTInteractionF = TPTSegmentPotential ( Q, U, F1, M1, TPTSeg1, TPTSeg2 )
if ( TPTInteractionF .ne. 1 ) return
call V3_V3xxV3 ( M2, DR, F1 )
F2 = - F1
M2 = - M1 - M2
call TPTSegmentForces ( F1_1, F1_2, F1, M1, Laxis1, L1 )
call TPTSegmentForces ( F2_1, F2_2, F2, M2, Laxis2, L2 )
end function TPTInteractionF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!---------------------------------------------------------------------------------------------------
! Initialization
!---------------------------------------------------------------------------------------------------
subroutine TPTInit ( R1, R2, NX, NE ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real*8, intent(in) :: R1, R2
integer*4, intent(in) :: NX, NE
!-------------------------------------------------------------------------------------------
TPTSeg1%X = 0.0d+00
TPTSeg1%Y = 0.0d+00
TPTSeg1%Z = 0.0d+00
TPTSeg1%Psi = 0.0d+00
TPTSeg1%Theta = 0.0d+00
TPTSeg1%Phi = 0.0d+00
TPTSeg1%R = R1
TPTSeg1%NX = NX
TPTSeg1%NE = NE
TPTSeg1%DE = M_2PI / NE
TPTSeg2%X = 0.0d+00
TPTSeg2%Y = 0.0d+00
TPTSeg2%Z = 0.0d+00
TPTSeg2%Psi = 0.0d+00
TPTSeg2%Theta = 0.0d+00
TPTSeg2%Phi = 0.0d+00
TPTSeg2%R = R2
TPTSeg2%NX = NX
TPTSeg2%NE = NE
TPTSeg2%DE = M_2PI / NE
end subroutine TPTInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module TubePotTrue !****************************************************************************

247
tools/cnt/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;
}