From e26be18b1e802d99b2d55c39c0c32f81e9fd1ffa Mon Sep 17 00:00:00 2001 From: iafoss Date: Mon, 18 May 2020 17:28:48 -0400 Subject: [PATCH] update --- cmake/CMakeLists.txt | 21 + doc/src/compute_mesont.rst | 27 +- doc/src/pair_mesont_tpm.rst | 71 +- examples/USER/mesont/README | 1 - examples/USER/mesont/in.bundle | 10 +- examples/USER/mesont/in.film | 9 +- .../USER/mesont/log.3Mar2020.bundle.g++.1 | 31 +- examples/USER/mesont/log.3Mar2020.film.g++.1 | 50 +- lib/mesont/CNTPot.f90 | 270 +++---- lib/mesont/ExportCNT.f90 | 129 +-- lib/mesont/Install.py | 98 ++- lib/mesont/LinFun2.f90 | 4 +- lib/mesont/Makefile.gfortran | 3 +- lib/mesont/Makefile.ifort | 2 +- lib/mesont/Makefile.serial | 56 +- lib/mesont/Spline1.f90 | 25 +- lib/mesont/Spline2.f90 | 20 +- lib/mesont/TPMForceField.f90 | 162 ++-- lib/mesont/TPMGeom.f90 | 44 +- lib/mesont/TPMLib.f90 | 38 +- lib/mesont/TPMM0.f90 | 19 +- lib/mesont/TPMM1.f90 | 25 +- lib/mesont/TubePotBase.f90 | 100 +-- lib/mesont/TubePotMono.f90 | 399 +++++----- lib/mesont/TubePotTrue.f90 | 43 +- potentials/CNT_10_10/TPMA.xrs | 21 - .../TPMSSTP.xrs => MESONT-TABTP_10_10.xrs} | 24 + src/Makefile | 2 +- src/USER-MESONT/README | 7 +- src/USER-MESONT/compute_mesont.cpp | 29 +- src/USER-MESONT/compute_mesont.h | 2 +- src/USER-MESONT/export_mesont.h | 3 +- src/USER-MESONT/pair_mesont_tpm.cpp | 53 +- src/atom_vec.cpp | 1 - tools/mesont/CNTPot.f90 | 734 ------------------ tools/mesont/ExportCNT.f90 | 125 --- tools/mesont/Makefile.gfortran | 56 -- tools/mesont/Makefile.ifort | 52 -- tools/mesont/Makefile.lammps | 5 - tools/mesont/Makefile.lammps.gfortran | 5 - tools/mesont/Makefile.lammps.ifort | 5 - tools/mesont/Makefile.serial | 1 - tools/mesont/README | 111 ++- tools/mesont/TMDGen/Makefile | 33 + tools/mesont/TMDGen/TMDGen.f90 | 267 +++++++ tools/mesont/TMDGen/TMDGen.xdt | 15 + tools/mesont/TMDGen/TMDGen3D.f90 | 231 ++++++ tools/mesont/TMDGen/TMDGenData.f90 | 289 +++++++ tools/mesont/TMDGen/TMDSample.in | 45 ++ tools/mesont/{ => TMDGen}/TPMGeom.f90 | 61 +- tools/mesont/TMDGen/TPMLib.f90 | 205 +++++ tools/mesont/{ => TMDPotGen}/LinFun2.f90 | 79 +- tools/mesont/TMDPotGen/Makefile | 35 + tools/mesont/{ => TMDPotGen}/Spline1.f90 | 97 +-- tools/mesont/{ => TMDPotGen}/Spline2.f90 | 77 +- tools/mesont/TMDPotGen/TMDPotGen.f90 | 62 ++ tools/mesont/TMDPotGen/TMDPotGen.xdt | 2 + tools/mesont/TMDPotGen/TPMGeom.f90 | 144 ++++ tools/mesont/{ => TMDPotGen}/TPMLib.f90 | 98 +-- tools/mesont/{ => TMDPotGen}/TubePotBase.f90 | 193 ++--- tools/mesont/{ => TMDPotGen}/TubePotMono.f90 | 694 +++++++++-------- tools/mesont/{ => TMDPotGen}/TubePotTrue.f90 | 178 ++--- tools/mesont/TPMForceField.f90 | 290 ------- tools/mesont/TPMM0.f90 | 195 ----- tools/mesont/TPMM1.f90 | 379 --------- tools/mesont/dump2vtk.cpp | 247 ++++++ 66 files changed, 3277 insertions(+), 3532 deletions(-) delete mode 100644 potentials/CNT_10_10/TPMA.xrs rename potentials/{CNT_10_10/TPMSSTP.xrs => MESONT-TABTP_10_10.xrs} (99%) delete mode 100644 tools/mesont/CNTPot.f90 delete mode 100644 tools/mesont/ExportCNT.f90 delete mode 100644 tools/mesont/Makefile.gfortran delete mode 100644 tools/mesont/Makefile.ifort delete mode 100644 tools/mesont/Makefile.lammps delete mode 100644 tools/mesont/Makefile.lammps.gfortran delete mode 100644 tools/mesont/Makefile.lammps.ifort delete mode 100644 tools/mesont/Makefile.serial create mode 100644 tools/mesont/TMDGen/Makefile create mode 100644 tools/mesont/TMDGen/TMDGen.f90 create mode 100644 tools/mesont/TMDGen/TMDGen.xdt create mode 100644 tools/mesont/TMDGen/TMDGen3D.f90 create mode 100644 tools/mesont/TMDGen/TMDGenData.f90 create mode 100644 tools/mesont/TMDGen/TMDSample.in rename tools/mesont/{ => TMDGen}/TPMGeom.f90 (72%) create mode 100644 tools/mesont/TMDGen/TPMLib.f90 rename tools/mesont/{ => TMDPotGen}/LinFun2.f90 (50%) create mode 100644 tools/mesont/TMDPotGen/Makefile rename tools/mesont/{ => TMDPotGen}/Spline1.f90 (65%) rename tools/mesont/{ => TMDPotGen}/Spline2.f90 (70%) create mode 100644 tools/mesont/TMDPotGen/TMDPotGen.f90 create mode 100644 tools/mesont/TMDPotGen/TMDPotGen.xdt create mode 100644 tools/mesont/TMDPotGen/TPMGeom.f90 rename tools/mesont/{ => TMDPotGen}/TPMLib.f90 (68%) rename tools/mesont/{ => TMDPotGen}/TubePotBase.f90 (55%) rename tools/mesont/{ => TMDPotGen}/TubePotMono.f90 (73%) rename tools/mesont/{ => TMDPotGen}/TubePotTrue.f90 (75%) delete mode 100644 tools/mesont/TPMForceField.f90 delete mode 100644 tools/mesont/TPMM0.f90 delete mode 100644 tools/mesont/TPMM1.f90 create mode 100644 tools/mesont/dump2vtk.cpp diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index 36bed2d649..5e114acbfe 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -452,6 +452,27 @@ foreach(SIMPLE_LIB POEMS USER-ATC USER-AWPMD USER-H5MD) endif() endforeach() +if(PKG_USER-MESONT) + enable_language(Fortran) + string(REGEX REPLACE "^USER-" "" PKG_LIB "USER-MESONT") + string(TOLOWER "${PKG_LIB}" PKG_LIB) + file(GLOB_RECURSE ${PKG_LIB}_SOURCES + ${LAMMPS_LIB_SOURCE_DIR}/${PKG_LIB}/[^.]*.f90) + add_library(${PKG_LIB} STATIC ${${PKG_LIB}_SOURCES}) + list(APPEND LAMMPS_LINK_LIBS ${PKG_LIB}) + target_include_directories(${PKG_LIB} PUBLIC ${LAMMPS_LIB_SOURCE_DIR}/${PKG_LIB}) + #include(Packages/USER-MESONT) + #list(APPEND DEFAULT_PACKAGES "USER-MESONT") + set(USER-MESONT_SOURCES_DIR ${LAMMPS_SOURCE_DIR}/USER-MESONT) + file(GLOB USER-MESONT_SOURCES ${USER-MESONT_SOURCES_DIR}/[^.]*.cpp) + file(GLOB USER-MESONT_HEADERS ${USER-MESONT_SOURCES_DIR}/[^.]*.h) + DetectBuildSystemConflict(${LAMMPS_SOURCE_DIR} ${USER-MESONT_SOURCES} ${USER-MESONT_HEADERS}) + RegisterStyles(${USER-MESONT_SOURCES_DIR}) + list(APPEND LIB_SOURCES ${USER-MESONT_SOURCES}) + include_directories(${USER-MESONT_SOURCES_DIR}) + +endif() + if(PKG_USER-AWPMD) target_link_libraries(awpmd ${LAPACK_LIBRARIES}) endif() diff --git a/doc/src/compute_mesont.rst b/doc/src/compute_mesont.rst index 8470059bdd..8352d43726 100644 --- a/doc/src/compute_mesont.rst +++ b/doc/src/compute_mesont.rst @@ -13,7 +13,7 @@ Syntax * ID, group-ID are documented in :doc:`compute ` command * mesont = style name of the compute command -* mode = one of estretch, ebend, etube, stretch_tot, ebend_tot, and etube_tot (see details below) +* mode = one of estretch, ebend, etube (see details below) Examples """""""" @@ -26,22 +26,19 @@ Examples Description """"""""""" -These computes define computations for the per-node stretching (estretch), -bending (ebend), and intertube (etube) energies, as well as the total -stretching (estretch_tot), bending (ebend_tot), and intertube (etube_tot) -energies for each atom (node) in a group. The evaluated value is selected by -a parameter passed to the compute: estretch, ebend, etube, estretch_tot, -ebend_tot, and etube_tot. +These computes define computations for the stretching (estretch), bending +(ebend), and intertube (etube) per-node (atom) and total energies. The +evaluated value is selected by a parameter passed to the compute: estretch, +ebend, etube. **Output info:** -These computes calculate per-node (per-atom) vectors (estretch, ebend, etube), -which can be accessed by any command that uses per-atom values from a -compute as input, and global scalars (stretch_tot, ebend_tot, and etube_tot). -See the :doc:`Howto output ` doc page for an overview of LAMMPS -output options. +These computes calculate per-node (per-atom) vectors, which can be accessed by +any command that uses per-atom values from a compute as input, and global +scalars. See the :doc:`Howto output ` doc page for an overview of +LAMMPS output options. -The per-atom vector values will be in energy :doc:`units `. +The computed values are provided in energy :doc:`units `. Restrictions """""""""""" @@ -57,7 +54,3 @@ Related commands **Default:** none - -.. _lws: http://lammps.sandia.gov -.. _ld: Manual.html -.. _lc: Commands_all.html diff --git a/doc/src/pair_mesont_tpm.rst b/doc/src/pair_mesont_tpm.rst index 996277f802..492e8cb97b 100644 --- a/doc/src/pair_mesont_tpm.rst +++ b/doc/src/pair_mesont_tpm.rst @@ -12,9 +12,9 @@ Syntax pair_style mesont/tpm cut table_path BendingMode TPMType * cut = the cutoff distance -* table_path = the path to the potential table, the default value is ./ -* BendingMode = the parameter defining the type of the bending potential for nanotubes: 0 - harmonic bending :ref:`[1] `, 1 - anharmonic potential of bending and bending-buckling :ref:`[2] ` -* TPMType = the parameter determining the type of the inter-tube interaction term: 0 - segment-segment approach, 1 - segment-chain approach :ref:`[3 `, :ref:`4] ` +* table_path = the path to the potential table +* BendingMode = the parameter defining the type of the bending potential for nanotubes: 0 - harmonic bending :ref:`(Srivastava) `, 1 - anharmonic potential of bending and bending-buckling :ref:`(Zhigilei1) ` +* TPMType = the parameter determining the type of the inter-tube interaction term: 0 - segment-segment approach, 1 - segment-chain approach :ref:`(Zhigilei2 `, :ref:`Zhigilei3) ` The segment-segment approach is approximately 5 times slower than segment-chain approximation. The parameter BendingMode also affects the calculation of the inter-tube interaction term when TPMType = 1. In this case, when BendingMode = 1, each continuous chain of segments is additionally replaced by a number of sub-chains divided by bending buckling kinks. @@ -25,14 +25,14 @@ Examples .. parsed-literal:: - pair_style mesont/tpm 25.0 ./ 0 0 + pair_style mesont/tpm 30.0 MESONT-TABTP_10_10.xrs 0 0 Description """"""""""" The tubular potential model (TPM) force field is designed for mesoscopic simulations of interacting flexible nanotubes. The force field is based on the -mesoscopic computational model suggested in Ref. :ref:`[1] `. +mesoscopic computational model suggested in Ref. :ref:`(Srivastava) `. In this model, each nanotube is represented by a chain of mesoscopic elements in the form of stretchable cylindrical segments, where each segment consists of multiple atoms. Each nanotube is divided into segments by a sequence of @@ -49,19 +49,19 @@ energy of the system: U = U_{str} + U_{bnd} + U_{vdW} where :math:`U_{str}` is the harmonic potential describing the stretching of nanotube -:ref:`[1] `, :math:`U_{bnd}` is the potential for nanotube bending -:ref:`[1] ` and bending-buckling :ref:`[2] `, and +:ref:`(Srivastava) `, :math:`U_{bnd}` is the potential for nanotube bending +:ref:`(Srivastava) ` and bending-buckling :ref:`(Zhigilei1) `, and :math:`U_{vdW}` is the potential describing van-der Waals interaction between nanotubes -:ref:`[3 `, :ref:`4] `. The stretching energy, :math:`U_{str}` , +:ref:`(Zhigilei2 `, :ref:`Zhigilei3) `. The stretching energy, :math:`U_{str}` , is given by the sum of stretching energies of individual nanotube segments. The bending energy, :math:`U_{bnd}` , is given by the sum of bending energies in all internal nanotube nodes. The tube-tube interaction energy, :math:`U_{vdW}` , is calculated -based on the tubular potential method suggested in Ref. :ref:`[3] `. +based on the tubular potential method suggested in Ref. :ref:`(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] `. This potential approximates the results of direct +:ref:`(Zhigilei3) `. This potential approximates the results of direct integration of carbon-carbon interatomic potential over the surfaces of the interacting nanotubes, with the force sources homogeneously distributed over the nanotube surfaces. The input data for calculation of tubular potentials @@ -69,7 +69,7 @@ are partially tabulated. For single-walled CNTs of arbitrary chirality, the tabulated potential data can be generated in the form of ASCII files TPMSSTP.xrs and TPMA.xrs by the stand-alone code TMDPotGen included in the tool directory of LAMMPS release. The potential provided with LAMMPS release, -CNT\_10\_10, is tabulated for (10,10) nanotubes. +MESONT-TABTP_10_10.xrs, is tabulated for (10,10) nanotubes. Calculations of the interaction between curved or bent nanotubes are performed on either segment-segment or segment-chain basis. In the first case, activated @@ -88,7 +88,7 @@ the segment-chain approach. In this case, for each NT segment, the list of its neighboring segments is divided into short continuous chains of segments belonging to individual nanotubes. For each pair of a segment and a chain, the curved chain is approximated by a straight equivalent nanotube based on the -weighted approach suggested in Ref. :ref:`[3] `. Finally, the +weighted approach suggested in Ref. :ref:`(Zhigilei2) `. Finally, the interaction between the segment and straight equivalent chain is calculated based on the tubular potential. In this case, and in the absence of bending buckling (i.e., when parameter BendingMode is equal to 0), the tubular @@ -96,7 +96,7 @@ potential method ensures the absence of corrugation of the effective inter-tube interaction potential for curved nanotubes and eliminates any barriers for the inter-tube sliding. As a result, the tubular potential method can describe the spontaneous self-assembly of nanotubes into continuous networks of bundles -:ref:`[2 `, :ref:`4] `. +:ref:`(Zhigilei1 `, :ref:`Zhigilei3) `. ---------- @@ -106,15 +106,17 @@ The TMD force field has been used for generation of nanotube films, fibers, and vertically aligned forests of nanotubes. Mesoscopic dynamic simulations were used to prepare realistic structures of continuous networks of nanotube bundles and to study their structural and mechanical properties -:ref:`[2 `, :ref:`4 ` - :ref:`7] `. With +:ref:`(Zhigilei1 `, :ref:`Zhigilei3 `, :ref:`Zhigilei4 `, +:ref:`Zhigilei5 `, :ref:`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 ` - :ref:`10] `. The methods for modeling of +:ref:`(Zhigilei7 `, :ref:`Zhigilei8 `, :ref:`Zhigilei8) `. +The methods for modeling of the mechanical energy dissipation into heat (energy exchange between the dynamic degrees of freedom of the mesoscopic model and the energy of atomic vibrations that are not explicitly represented in the model) -:ref:`[11] ` and mesoscopic description of covalent cross-links -between nanotubes :ref:`[12] ` have also been developed but are not +:ref:`(Zhigilei10) ` and mesoscopic description of covalent cross-links +between nanotubes :ref:`(Banna) ` have also been developed but are not included in this first release of the LAMMPS implementation of the force field. Further details can be found in references provided below. @@ -142,10 +144,11 @@ pair interactions. The cutoff distance should be set to be at least :math:`max\left[2L,\sqrt{L^2/2+(2R+T_{cut})^2}\right]` , where L is the maximum segment length, R is the maximum tube radius, and :math:`T_{cut}` = 10.2 A is the maximum distance between the surfaces of interacting -segments. +segments. Because of the use of extended chain concept at CNT ends, the recommended +cutoff is 3L. -The TPMSSTP.xrs and TPMA.xrs potential files provided with LAMMPS (see the -potentials directory) are parameterized for metal :doc:`units `. +The MESONT-TABTP_10_10.xrs potential file provided with LAMMPS (see the +potentials directory) is parameterized for metal :doc:`units `. You can use the carbon nanotube mesoscopic force field with any LAMMPS units, but you would need to create your own TPMSSTP.xrs and TPMA.xrs potential files with coefficients listed in appropriate units, if your simulation @@ -163,53 +166,49 @@ Related commands .. _Srivastava: -**[1]** Zhigilei, Wei, Srivastava, Phys. Rev. B 71, 165417 (2005). +**(Srivastava)** Zhigilei, Wei, Srivastava, Phys. Rev. B 71, 165417 (2005). .. _Zhigilei1: -**[2]** Volkov and Zhigilei, ACS Nano 4, 6187 (2010). +**(Zhigilei1)** Volkov and Zhigilei, ACS Nano 4, 6187 (2010). .. _Zhigilei2: -**[3]** Volkov, Simov, Zhigilei, ASME paper IMECE2008, 68021 (2008). +**(Zhigilei2)** Volkov, Simov, Zhigilei, ASME paper IMECE2008, 68021 (2008). .. _Zhigilei3: -**[4]** Volkov, Zhigilei, J. Phys. Chem. C 114, 5513 (2010). +**(Zhigilei3)** Volkov, Zhigilei, J. Phys. Chem. C 114, 5513 (2010). .. _Zhigilei4: -**[5]** Wittmaack, Banna, Volkov, Zhigilei, Carbon 130, 69 (2018). +**(Zhigilei4)** Wittmaack, Banna, Volkov, Zhigilei, Carbon 130, 69 (2018). .. _Zhigilei5: -**[6]** Wittmaack, Volkov, Zhigilei, Compos. Sci. Technol. 166, 66 (2018). +**(Zhigilei5)** Wittmaack, Volkov, Zhigilei, Compos. Sci. Technol. 166, 66 (2018). .. _Zhigilei6: -**[7]** Wittmaack, Volkov, Zhigilei, Carbon 143, 587 (2019). +**(Zhigilei6)** Wittmaack, Volkov, Zhigilei, Carbon 143, 587 (2019). .. _Zhigilei7: -**[8]** Volkov, Zhigilei, Phys. Rev. Lett. 104, 215902 (2010). +**(Zhigilei7)** Volkov, Zhigilei, Phys. Rev. Lett. 104, 215902 (2010). .. _Zhigilei8: -**[9]** Volkov, Shiga, Nicholson, Shiomi, Zhigilei, J. Appl. Phys. 111, 053501 (2012). +**(Zhigilei8)** Volkov, Shiga, Nicholson, Shiomi, Zhigilei, J. Appl. Phys. 111, 053501 (2012). .. _Zhigilei9: -**[10]** Volkov, Zhigilei, Appl. Phys. Lett. 101, 043113 (2012). +**(Zhigilei9)** Volkov, Zhigilei, Appl. Phys. Lett. 101, 043113 (2012). .. _Zhigilei10: -**[11]** Jacobs, Nicholson, Zemer, Volkov, Zhigilei, Phys. Rev. B 86, 165414 (2012). +**(Zhigilei10)** Jacobs, Nicholson, Zemer, Volkov, Zhigilei, Phys. Rev. B 86, 165414 (2012). .. _Banna: -**[12]** Volkov, Banna, Comp. Mater. Sci. 176, 109410 (2020). +**(Banna)** Volkov, Banna, Comp. Mater. Sci. 176, 109410 (2020). - -.. _lws: http://lammps.sandia.gov -.. _ld: Manual.html -.. _lc: Commands_all.html diff --git a/examples/USER/mesont/README b/examples/USER/mesont/README index 6d3eb95ab1..9acc913257 100644 --- a/examples/USER/mesont/README +++ b/examples/USER/mesont/README @@ -11,4 +11,3 @@ Contributing author: Maxim Shugaev (UVA), mvs9t@virginia.edu "film" is an example with a film composed of 396 200-nm-long nanotubes (79596 nodes). - diff --git a/examples/USER/mesont/in.bundle b/examples/USER/mesont/in.bundle index b5b0e1b99a..56e42848f3 100644 --- a/examples/USER/mesont/in.bundle +++ b/examples/USER/mesont/in.bundle @@ -1,3 +1,4 @@ +processors 1 1 * newton on units metal lattice sc 1.0 @@ -7,7 +8,7 @@ neigh_modify every 5 delay 0 check yes atom_style mesont # cut, path, BendingMode, TPMType -pair_style mesont/tpm 45.0 ../../../potentials/CNT_10_10 0 0 +pair_style mesont/tpm 45.0 ../../../potentials/MESONT-TABTP_10_10.xrs 0 0 read_data data.bundle pair_coeff * * @@ -22,11 +23,8 @@ compute Es all mesont estretch compute Eb all mesont ebend compute Et all mesont etube compute B all property/atom buckling -compute Es_tot all mesont estretch_tot -compute Eb_tot all mesont ebend_tot -compute Et_tot all mesont etube_tot -thermo_style custom step time temp etotal ke pe c_Es_tot c_Eb_tot c_Et_tot +thermo_style custom step time temp etotal ke pe c_Es c_Eb c_Et #dump out_dump all custom 50 dump.bundle id type x y z c_Es c_Eb c_Et c_B ix iy iz -run 100 \ No newline at end of file +run 100 diff --git a/examples/USER/mesont/in.film b/examples/USER/mesont/in.film index bfcc77c242..2e59a4c436 100644 --- a/examples/USER/mesont/in.film +++ b/examples/USER/mesont/in.film @@ -7,7 +7,7 @@ neigh_modify every 5 delay 0 check yes atom_style mesont # cut, path, BendingMode, TPMType -pair_style mesont/tpm 25.0 ../../../potentials/CNT_10_10 1 0 +pair_style mesont/tpm 30.0 ../../../potentials/MESONT-TABTP_10_10.xrs 1 0 read_data data.film pair_coeff * * @@ -22,11 +22,8 @@ compute Es all mesont estretch compute Eb all mesont ebend compute Et all mesont etube compute B all property/atom buckling -compute Es_tot all mesont estretch_tot -compute Eb_tot all mesont ebend_tot -compute Et_tot all mesont etube_tot -thermo_style custom step time temp etotal ke pe c_Es_tot c_Eb_tot c_Et_tot +thermo_style custom step time temp etotal ke pe c_Es c_Eb c_Et #dump out_dump all custom 10 dump.film id type x y z c_Es c_Eb c_Et c_B ix iy iz -run 10 \ No newline at end of file +run 10 diff --git a/examples/USER/mesont/log.3Mar2020.bundle.g++.1 b/examples/USER/mesont/log.3Mar2020.bundle.g++.1 index a1ef6640a6..5c9a788167 100644 --- a/examples/USER/mesont/log.3Mar2020.bundle.g++.1 +++ b/examples/USER/mesont/log.3Mar2020.bundle.g++.1 @@ -1,4 +1,6 @@ LAMMPS (3 Mar 2020) + using 1 OpenMP thread(s) per MPI task +processors 1 1 * newton on units metal lattice sc 1.0 @@ -9,13 +11,13 @@ neigh_modify every 5 delay 0 check yes atom_style mesont # cut, path, BendingMode, TPMType -pair_style mesont/tpm 45.0 ../../../potentials/CNT_10_10 0 0 +pair_style mesont/tpm 45.0 ../../../potentials/MESONT-TABTP_10_10.xrs 0 0 read_data data.bundle orthogonal box = (-143.89 -143.89 0) to (143.89 143.89 220) 1 by 1 by 1 MPI processor grid reading atoms ... 77 atoms - read_data CPU = 0.442627 secs + read_data CPU = 0.025475 secs pair_coeff * * velocity all create 6000.0 2019 @@ -29,11 +31,8 @@ compute Es all mesont estretch compute Eb all mesont ebend compute Et all mesont etube compute B all property/atom buckling -compute Es_tot all mesont estretch_tot -compute Eb_tot all mesont ebend_tot -compute Et_tot all mesont etube_tot -thermo_style custom step time temp etotal ke pe c_Es_tot c_Eb_tot c_Et_tot +thermo_style custom step time temp etotal ke pe c_Es c_Eb c_Et WARNING: New thermo_style command, previous thermo_modify settings will be lost (../output.cpp:708) #dump out_dump all custom 50 dump.bundle id type x y z c_Es c_Eb c_Et c_B ix iy iz @@ -51,7 +50,7 @@ Neighbor list info ... stencil: full/ghost/bin/3d bin: standard Per MPI rank memory allocation (min/avg/max) = 4.675 | 4.675 | 4.675 Mbytes -Step Time Temp TotEng KinEng PotEng c_Es_tot c_Eb_tot c_Et_tot +Step Time Temp TotEng KinEng PotEng c_Es c_Eb c_Et 0 0 6000 -201.86935 58.942626 -260.81198 0 0 -260.81198 10 0.05 5114.1875 -201.86234 50.240607 -252.10295 4.8334861 2.3998206 -259.33626 20 0.1 3437.2958 -201.8522 33.767207 -235.61941 11.42384 8.3426957 -255.38594 @@ -63,20 +62,20 @@ Step Time Temp TotEng KinEng PotEng c_Es_tot c_Eb_tot c_Et_tot 80 0.4 3849.9855 -201.8635 37.821376 -239.68487 7.9899173 6.4332848 -254.10807 90 0.45 3618.1311 -201.85967 35.543692 -237.40336 9.2616931 7.0452637 -253.71032 100 0.5 2866.2722 -201.85273 28.157602 -230.01033 12.204916 10.284525 -252.49977 -Loop time of 0.455531 on 1 procs for 100 steps with 77 atoms +Loop time of 0.457417 on 1 procs for 100 steps with 77 atoms -Performance: 94.834 ns/day, 0.253 hours/ns, 219.524 timesteps/s -99.7% CPU use with 1 MPI tasks x no OpenMP threads +Performance: 94.443 ns/day, 0.254 hours/ns, 218.619 timesteps/s +99.6% CPU use with 1 MPI tasks x 1 OpenMP threads MPI task timing breakdown: Section | min time | avg time | max time |%varavg| %total --------------------------------------------------------------- -Pair | 0.4551 | 0.4551 | 0.4551 | 0.0 | 99.91 -Neigh | 6.485e-05 | 6.485e-05 | 6.485e-05 | 0.0 | 0.01 -Comm | 3.0994e-05 | 3.0994e-05 | 3.0994e-05 | 0.0 | 0.01 -Output | 0.00020385 | 0.00020385 | 0.00020385 | 0.0 | 0.04 -Modify | 8.6069e-05 | 8.6069e-05 | 8.6069e-05 | 0.0 | 0.02 -Other | | 4.697e-05 | | | 0.01 +Pair | 0.45698 | 0.45698 | 0.45698 | 0.0 | 99.90 +Neigh | 5.6982e-05 | 5.6982e-05 | 5.6982e-05 | 0.0 | 0.01 +Comm | 4.4584e-05 | 4.4584e-05 | 4.4584e-05 | 0.0 | 0.01 +Output | 0.00019693 | 0.00019693 | 0.00019693 | 0.0 | 0.04 +Modify | 7.4863e-05 | 7.4863e-05 | 7.4863e-05 | 0.0 | 0.02 +Other | | 6.318e-05 | | | 0.01 Nlocal: 77 ave 77 max 77 min Histogram: 1 0 0 0 0 0 0 0 0 0 diff --git a/examples/USER/mesont/log.3Mar2020.film.g++.1 b/examples/USER/mesont/log.3Mar2020.film.g++.1 index 7b375bda31..abf307a083 100644 --- a/examples/USER/mesont/log.3Mar2020.film.g++.1 +++ b/examples/USER/mesont/log.3Mar2020.film.g++.1 @@ -1,4 +1,5 @@ LAMMPS (3 Mar 2020) + using 1 OpenMP thread(s) per MPI task newton on units metal lattice sc 1.0 @@ -9,13 +10,13 @@ neigh_modify every 5 delay 0 check yes atom_style mesont # cut, path, BendingMode, TPMType -pair_style mesont/tpm 25.0 ../../../potentials/CNT_10_10 1 0 +pair_style mesont/tpm 30.0 ../../../potentials/MESONT-TABTP_10_10.xrs 1 0 read_data data.film orthogonal box = (-2500 -2500 -300) to (2500 2500 402.42) 1 by 1 by 1 MPI processor grid reading atoms ... 79596 atoms - read_data CPU = 0.0903821 secs + read_data CPU = 0.110827 secs pair_coeff * * velocity all create 600.0 2019 @@ -29,11 +30,8 @@ compute Es all mesont estretch compute Eb all mesont ebend compute Et all mesont etube compute B all property/atom buckling -compute Es_tot all mesont estretch_tot -compute Eb_tot all mesont ebend_tot -compute Et_tot all mesont etube_tot -thermo_style custom step time temp etotal ke pe c_Es_tot c_Eb_tot c_Et_tot +thermo_style custom step time temp etotal ke pe c_Es c_Eb c_Et WARNING: New thermo_style command, previous thermo_modify settings will be lost (../output.cpp:708) #dump out_dump all custom 10 dump.film id type x y z c_Es c_Eb c_Et c_B ix iy iz @@ -41,45 +39,45 @@ run 10 Neighbor list info ... update every 5 steps, delay 0 steps, check yes max neighbors/atom: 2000, page size: 100000 - master list distance cutoff = 26 - ghost atom cutoff = 26 - binsize = 13, bins = 385 385 31 + master list distance cutoff = 31 + ghost atom cutoff = 31 + binsize = 15.5, bins = 323 323 26 1 neighbor lists, perpetual/occasional/extra = 1 0 0 (1) pair mesont/tpm, perpetual attributes: full, newton on, ghost pair build: full/bin/ghost stencil: full/ghost/bin/3d bin: standard -Per MPI rank memory allocation (min/avg/max) = 44.83 | 44.83 | 44.83 Mbytes -Step Time Temp TotEng KinEng PotEng c_Es_tot c_Eb_tot c_Et_tot - 0 0 600 1347.2177 6173.0767 -4825.859 28.669574 21.29406 -4875.8226 - 10 0.1 389.40755 1373.7883 4006.4045 -2632.6161 848.00269 1404.4323 -4885.0511 -Loop time of 4.21003 on 1 procs for 10 steps with 79596 atoms +Per MPI rank memory allocation (min/avg/max) = 37.43 | 37.43 | 37.43 Mbytes +Step Time Temp TotEng KinEng PotEng c_Es c_Eb c_Et + 0 0 600 1347.2158 6173.0767 -4825.8609 28.669574 21.29406 -4875.8245 + 10 0.1 389.40755 1373.7864 4006.4045 -2632.6181 848.00267 1404.4323 -4885.053 +Loop time of 5.41853 on 1 procs for 10 steps with 79596 atoms -Performance: 2.052 ns/day, 11.695 hours/ns, 2.375 timesteps/s -97.8% CPU use with 1 MPI tasks x no OpenMP threads +Performance: 1.595 ns/day, 15.051 hours/ns, 1.846 timesteps/s +97.7% CPU use with 1 MPI tasks x 1 OpenMP threads MPI task timing breakdown: Section | min time | avg time | max time |%varavg| %total --------------------------------------------------------------- -Pair | 4.1942 | 4.1942 | 4.1942 | 0.0 | 99.62 +Pair | 5.4022 | 5.4022 | 5.4022 | 0.0 | 99.70 Neigh | 0 | 0 | 0 | 0.0 | 0.00 -Comm | 0.00046039 | 0.00046039 | 0.00046039 | 0.0 | 0.01 -Output | 0.00029182 | 0.00029182 | 0.00029182 | 0.0 | 0.01 -Modify | 0.012385 | 0.012385 | 0.012385 | 0.0 | 0.29 -Other | | 0.002726 | | | 0.06 +Comm | 0.00052881 | 0.00052881 | 0.00052881 | 0.0 | 0.01 +Output | 0.00029206 | 0.00029206 | 0.00029206 | 0.0 | 0.01 +Modify | 0.012906 | 0.012906 | 0.012906 | 0.0 | 0.24 +Other | | 0.002562 | | | 0.05 Nlocal: 79596 ave 79596 max 79596 min Histogram: 1 0 0 0 0 0 0 0 0 0 -Nghost: 1567 ave 1567 max 1567 min +Nghost: 1879 ave 1879 max 1879 min Histogram: 1 0 0 0 0 0 0 0 0 0 Neighs: 0 ave 0 max 0 min Histogram: 1 0 0 0 0 0 0 0 0 0 -FullNghs: 412798 ave 412798 max 412798 min +FullNghs: 642270 ave 642270 max 642270 min Histogram: 1 0 0 0 0 0 0 0 0 0 -Total # of neighbors = 412798 -Ave neighs/atom = 5.18617 +Total # of neighbors = 642270 +Ave neighs/atom = 8.06912 Neighbor list builds = 0 Dangerous builds = 0 -Total wall time: 0:00:05 +Total wall time: 0:00:07 diff --git a/lib/mesont/CNTPot.f90 b/lib/mesont/CNTPot.f90 index 934d644c67..74fa0dd9ef 100644 --- a/lib/mesont/CNTPot.f90 +++ b/lib/mesont/CNTPot.f90 @@ -15,13 +15,13 @@ module CNTPot !************************************************************************************* ! -! TMD Library: Mesoscopic potential for internal modes in CNTs +! Mesoscopic potential for internal modes in CNTs. ! !--------------------------------------------------------------------------------------------------- ! -! Implementation of carbon nanotubes internal potentials: +! Carbon nanotubes internal potentials: ! CNTSTRH0, harmonic stretching potential of type 0 with constant Young's modulus -! CNTSTRH1, harmonic stretching potential of type 1 with variable Youngs modulus +! CNTSTRH1, harmonic stretching potential of type 1 with variable Young's modulus ! CNTSTRNH0, non-harmonic stretching with fracture potential of type 0 ! CNTSTRNH1, non-harmonic stretching with fracture potential of type 1 ! CNTBNDH, harmonic bending potential @@ -30,33 +30,32 @@ module CNTPot !***************************************************************** ! CNTTRS, torsion potential ! CNTBRT, breathing potential ! -! The functional form and force constants of harmonic streatching, bending and +! The functional form and force constants of harmonic stretching, bending and ! torsion potentials are taken from: ! L.V. Zhigilei, Ch. Wei, D. Srivastava, Phys. Rev. B 71, 165417 (2005) ! -! The model of stress-strain curve for non-harmonic potential with fracture -! is developed and parameterized with the help of constant -! -- Young's modulus (Pa), -! -- maximal linear strain (only for the NH potential of type 1) -! -- tensile strength (or fracture strain, Pa), +! The model of stress-strain curve for the non-harmonic potential with fracture +! is developed and parameterized using the following constants +! -- Young's modulus +! -- maximum linear strain (only for the NH potential of type 1) +! -- tensile strength (or fracture strain) ! -- strain at failure (or fracture strain) -! -- maximal strain. -! All these parameters are assumed to be independent of SWCNT radius or type. -! In this model true strain at failure CNTSTREft and true tensile strength -! CNTSTRSft are slightly different from imposed values CNTSTREf and CNTSTRSf. -! This difference is really small and is not taken into account. +! -- maximum strain. +! All these parameters are assumed to be independent of CNT radius or chriality type. +! In this model, the true strain at failure CNTSTREft and true tensile strength +! CNTSTRSft are slightly different from the imposed values CNTSTREf and CNTSTRSf. ! ! The non-harmonic stretching potentials of types 0 and 1 are different from ! each other by the functional form of the stress-strain curve ! -! Different parameterizations of CNTSTRH0, CNTSTRNH0 and CNTSTRNH1 potentials -! can be chosen, see subroutine CNTSTRSetParameterization +! Different parameterizations of CNTSTRH0, CNTSTRNH0 and CNTSTRNH1 potentials can be chosen, +! see subroutine CNTSTRSetParameterization ! !--------------------------------------------------------------------------------------------------- ! ! Intel Fortran ! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 08.02.m.m.2.m, 2017 +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020 ! !*************************************************************************************************** @@ -75,20 +74,27 @@ implicit none integer(c_int), parameter :: CNTPOT_BBUCKLING = 4 integer(c_int), parameter :: CNTPOT_BFRACTURE = 5 - integer(c_int), parameter :: CNTSTRMODEL_H0 = 0 ! Harmonic stetching model (constant Young's modulus) - integer(c_int), parameter :: CNTSTRMODEL_H1 = 1 ! Harmonic stretching model (Young's modulus depends on radius) - integer(c_int), parameter :: CNTSTRMODEL_NH0F = 2 ! Non-harmonic stretching with fracture, potential of type 0 - integer(c_int), parameter :: CNTSTRMODEL_NH1 = 3 ! Non-harmonic stretching without fracture, potential of type 1 - integer(c_int), parameter :: CNTSTRMODEL_NH1F = 4 ! Non-harmonic stretching with fracture, potential of type 1 - integer(c_int), parameter :: CNTSTRMODEL_H1B = 5 ! Harmonic stetching model + axial buckling - integer(c_int), parameter :: CNTSTRMODEL_H1BH = 6 ! Harmonic stetching model + axial buckling + hysteresis + ! Harmonic stretching model (constant Young's modulus) + integer(c_int), parameter :: CNTSTRMODEL_H0 = 0 + ! Harmonic stretching model (Young's modulus depends on radius) + integer(c_int), parameter :: CNTSTRMODEL_H1 = 1 + ! Non-harmonic stretching with fracture, potential of type 0 + integer(c_int), parameter :: CNTSTRMODEL_NH0F = 2 + ! Non-harmonic stretching without fracture, potential of type 1 + integer(c_int), parameter :: CNTSTRMODEL_NH1 = 3 + ! Non-harmonic stretching with fracture, potential of type 1 + integer(c_int), parameter :: CNTSTRMODEL_NH1F = 4 + ! Harmonic stretching model + axial buckling + integer(c_int), parameter :: CNTSTRMODEL_H1B = 5 + ! Harmonic stretching model + axial buckling + hysteresis + integer(c_int), parameter :: CNTSTRMODEL_H1BH = 6 integer(c_int), parameter :: CNTBNDMODEL_H = 0 ! Harmonic bending model integer(c_int), parameter :: CNTBNDMODEL_HB = 1 ! Harmonic bending - buckling model integer(c_int), parameter :: CNTBNDMODEL_HBF = 2 ! Harmonic bending - buckling - fracture model integer(c_int), parameter :: CNTBNDMODEL_HBH = 3 ! Harmonic bending - buckling + Hysteresis - integer(c_int), parameter :: CNTPOTNMAX = 4000 ! Maximal number of points in interpolation tables + integer(c_int), parameter :: CNTPOTNMAX = 4000 ! Maximum number of points in the interpolation tables !--------------------------------------------------------------------------------------------------- ! Parameters of potentials @@ -96,53 +102,51 @@ implicit none ! Stretching potential - integer(c_int) :: CNTSTRModel = CNTSTRMODEL_H1! Type of the bending model - integer(c_int) :: CNTSTRParams = 0 ! Type of parameterization - integer(c_int) :: CNTSTRYMT = 0 ! Type of dependence of the Young's modulus on tube radius + ! Type of the bending model + integer(c_int) :: CNTSTRModel = CNTSTRMODEL_H1 + ! Type of parameterization + integer(c_int) :: CNTSTRParams = 0 + ! Type of dependence of the Young's modulus on tube radius + integer(c_int) :: CNTSTRYMT = 0 ! Parameters of non-harmonic potential and fracture model - real(c_double) :: CNTSTRR0 = 6.8d+00 ! Reference radius of nanotubes, A - ! (this parameter is not used for the model - ! paramerization, but only for calcuation of the - ! force constant in eV/A) - real(c_double) :: CNTSTRD0 = 3.4d+00 ! CNT wall thickness (diameter of carbon atom), A - real(c_double) :: CNTSTREmin = -0.4d+00 ! Minimal strain in tabulated potential - real(c_double) :: CNTSTREmax = 0.13d+00 ! Maximal strain in tabulated potential. Simultaneously, U=0 if E> CNTSTREmax - real(c_double) :: CNTSTREl = 5.0d-02 ! Maximal linear strain + real(c_double) :: CNTSTRR0 = 6.8d+00 ! Reference radius of nanotubes (A) + ! (this parameter is not used for the model + ! parametrization, but only for calculation of the + ! force constant in eV/A) + real(c_double) :: CNTSTRD0 = 3.4d+00 ! CNT wall thickness (A) + real(c_double) :: CNTSTREmin = -0.4d+00 ! Minimum strain in tabulated potential + real(c_double) :: CNTSTREmax = 0.13d+00 ! Maximum strain in tabulated potential. + ! Simultaneously, U=0 if E> CNTSTREmax + real(c_double) :: CNTSTREl = 5.0d-02 ! Maximum linear strain real(c_double) :: CNTSTREf = 12.0d-02 ! Strain at failure - real(c_double) :: CNTSTRS0 = 0.850e+12 ! Young's modulus, Pa - real(c_double) :: CNTSTRSl ! Maximal linear strees, Pa - real(c_double) :: CNTSTRSf = 75.0d+09 ! Tensile strength, Pa - real(c_double) :: CNTSTRF0 ! Elastic force constant, eV/A**2 - real(c_double) :: CNTSTRFl ! Maximal linear force, eV/A**2 - real(c_double) :: CNTSTRFf ! Tensile force at failure, eV/A**2 - real(c_double) :: CNTSTRSi ! Maximal available stress (reference parameter, not used in the model), Pa + real(c_double) :: CNTSTRS0 = 0.850e+12 ! Young's modulus (Pa) + real(c_double) :: CNTSTRSl ! Maximum linear stress (Pa) + real(c_double) :: CNTSTRSf = 75.0d+09 ! Tensile strength (Pa) + real(c_double) :: CNTSTRF0 ! Elastic force constant (eV/A**2) + real(c_double) :: CNTSTRFl ! Maximal linear force, (eV/A**2) + real(c_double) :: CNTSTRFf ! Tensile force at failure (eV/A**2) + real(c_double) :: CNTSTRSi ! Maximum stress (not used in the model) (Pa) real(c_double) :: CNTSTRDf ! dF/dE at failure + real(c_double) :: CNTSTRAA, CNTSTRBB ! - real(c_double) :: CNTSTRAAA, CNTSTRBBB ! | Auxilary constants - real(c_double) :: CNTSTRUl, CNTSTRUf ! / + real(c_double) :: CNTSTRAAA, CNTSTRBBB ! Auxiliary constants + real(c_double) :: CNTSTRUl, CNTSTRUf ! - ! Axial buckling - hysteresis approch - real(c_double) :: CNTSTREc = -0.0142d+00 ! The minimal buckling strain - real(c_double) :: CNTSTREc1 = -0.04d+00 ! Critical axial buckling strain - real(c_double) :: CNTSTREc2 = -0.45d+00 ! Maximal buckling strain (the pot is harmonic for larger strains(in abs val)) - - !real(c_double) :: CNTSTRAmin - !real(c_double) :: CNTSTRAmax - !real(c_double) :: CNTSTRDA + ! Axial buckling - hysteresis approach + real(c_double) :: CNTSTREc = -0.0142d+00 ! The minimum buckling strain + real(c_double) :: CNTSTREc1 = -0.04d+00 ! Critical axial buckling strain + real(c_double) :: CNTSTREc2 = -0.45d+00 ! Maximum buckling strain ! Bending potential - integer(c_int) :: CNTBNDModel = CNTBNDMODEL_H ! Type of the bending model - !real(c_double) :: CNTBNDAmin - !real(c_double) :: CNTBNDAmax - !real(c_double) :: CNTBNDDA + integer(c_int) :: CNTBNDModel = CNTBNDMODEL_H ! Type of the bending model ! Buckling model parameters real(c_double) :: CNTBNDN = 1.0d+00 ! Buckling exponent real(c_double) :: CNTBNDB = 0.68d+00 ! Buckling number - real(c_double) :: CNTBNDR = 275.0d+00 ! Critical radius of curvarure, A - ! This is mean value for (10,10) SWCNT - real(c_double) :: CNTBNDTF = M_PI * 120.0d+00 / 180.0d+00 ! Fracture buckling angle, rad + real(c_double) :: CNTBNDR = 275.0d+00 ! Critical radius of curvature (A) + ! This is the mean value for (10,10) SWCNT + real(c_double) :: CNTBNDTF = M_PI * 120.0d+00 / 180.0d+00 ! Fracture buckling angle (rad) real(c_double) :: CNTBNDN1 real(c_double) :: CNTBNDC2 @@ -153,7 +157,7 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- subroutine CNTSTRSetParameterization ( PType ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Setup parameters for further parameterization of streatching models + ! This subroutine setups parameters for further parameterization of stretching models ! References: ! [1] Yu M.-F. et al., Phys. Rev. Lett. 84(24), 5552 (2000) ! [2] Liew K.M. et al., Acta Materialia 52, 2521 (2004) @@ -161,7 +165,7 @@ contains !********************************************************************** ! [4] Zhigilei L.V. et al., Phys. Rev. B 71, 165417 (2005) ! [5] Kelly B.T., Physics of graphite, 1981 !------------------------------------------------------------------------------------------- - integer(c_int), intent(in) :: PType + integer(c_int), intent(in) :: PType !------------------------------------------------------------------------------------------- select case ( PType ) case ( 0 ) ! This parametrization is based on averaged exp. data of Ref. [1] @@ -173,35 +177,36 @@ contains !********************************************************************** CNTSTREf = 3.14d-02 ! Ref. [1] CNTSTRS0 = 1.002e+12 ! Ref. [1] CNTSTRSf = 30.0d+09 ! Ref. [1] - case ( 1 ) ! This parameterization is taken from Ref. [2] for (10,10) SWCNT - ! These values are obtained in MD simulatuions with REBO potential - ! Values of Young's modulus, Tensile strenght and stress here + case ( 1 ) ! This parameterization is taken from Ref. [2] for (10,10) CNTs. + ! These values are obtained in MD simulations with REBO potential. + ! Values of Young's modulus, tensile strength and stress here ! are close to those obtained in Ref. [3] for pristine (defectless) - ! (5,5) SWCNT in semiempirical QM calcuilations based on PM3 model - CNTSTRR0 = 6.785d+00 ! Calculated with usual formula for (10,10) CNT + ! (5,5) CNT in semi-empirical QM calculations based on PM3 model + CNTSTRR0 = 6.785d+00 ! Calculated with the usual formula for (10,10) CNT CNTSTRD0 = 3.35d+00 ! Ref. [2] CNTSTREmin = -0.4d+00 ! Chosen arbitrary CNTSTREmax = 28.4d-02 ! = CNTSTREf + 0.005 CNTSTREl = 5.94d-02 ! Ref. [2] - CNTSTREf = 27.9d-02 ! Corresponds to Maximal strain in Ref. [2] + CNTSTREf = 27.9d-02 ! Corresponds to maximum strain in Ref. [2] CNTSTRS0 = 1.031e+12 ! Ref. [2] - CNTSTRSf = 148.5d+09 ! Corresponds to Tensile strength in Ref. [2] - case ( 2 ) ! This parametrization is taken from Ref. [3] for (5,5) SWCNT - ! with one atom vacancy defect obtained by semiempirical QM PM3 model + CNTSTRSf = 148.5d+09 ! Corresponds to tensile strength in Ref. [2] + case ( 2 ) ! This parametrization is taken from Ref. [3] for (5,5) CNTs + ! with one atom vacancy defect obtained with the semi-empirical QM PM3 model CNTSTRR0 = 3.43d+00 ! Ref. [3] CNTSTRD0 = 3.4d+00 ! Ref. [3] CNTSTREmin = -0.4d+00 ! Chosen arbitrary CNTSTREmax = 15.8d-02 ! = CNTSTREf + 0.005 - CNTSTREl = 6.00d-02 ! Chosed similar to Ref. [2] + CNTSTREl = 6.00d-02 ! Chosen similar to Ref. [2] CNTSTREf = 15.3d-02 ! Ref. [3] CNTSTRS0 = 1.100e+12 ! Ref. [3] CNTSTRSf = 100.0d+09 ! Ref. [3] - case ( 3 ) ! This special parameterization changes the only value of Young's modulus - ! with accordance with the stretching constant in Ref. [4] - CNTSTRS0 = ( 86.64d+00 + 100.56d+00 * CNTSTRR0 ) * K_MDFU / ( M_2PI * CNTSTRR0 * CNTSTRD0 * 1.0e-20 ) ! Ref. [4] - case ( 4 ) ! This special parameterization changes the only value of Young's modulus + case ( 3 ) ! This special parameterization changes only the value of Young's modulus + ! in accordance with the stretching constant in Ref. [4] + CNTSTRS0 = ( 86.64d+00 + 100.56d+00 * CNTSTRR0 ) * K_MDFU & + / ( M_2PI * CNTSTRR0 * CNTSTRD0 * 1.0d-20 ) ! Ref. [4] + case ( 4 ) ! This special parameterization changes only the value of Young's modulus ! making it equal to the in-plane Young's modulus of graphite - CNTSTRR0 = 6.785d+00 ! Calculated with usual formula for (10,10) CNT + CNTSTRR0 = 6.785d+00 ! Calculated with the usual formula for (10,10) CNT CNTSTRD0 = 3.4d+00 ! Ref. [1] CNTSTRS0 = 1.06e+12 ! Ref. [5] end select @@ -211,8 +216,8 @@ contains !********************************************************************** ! Stretching without fracture, harmonic potential ! - integer(c_int) function CNTSTRH0Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Young's modulus is independent of R + integer(c_int) function CNTSTRH0Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Young's modulus is independent of R. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: U, dUdL real(c_double), intent(in) :: L, R0, L0 @@ -224,8 +229,8 @@ contains !********************************************************************** CNTSTRH0Calc = CNTPOT_STRETCHING end function CNTSTRH0Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTSTRH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Young's modulus depends on R, see [4] + integer(c_int) function CNTSTRH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Young's modulus depends on R, see [4]. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: U, dUdL real(c_double), intent(in) :: L, R0, L0 @@ -242,9 +247,9 @@ contains !********************************************************************** ! Stretching without fracture, harmonic potential, with axial buckling without hysteresis ! - integer(c_int) function CNTSTRH1BCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Young's modulus depends on R, see [4] - ! Axial buckling without hysteresis + integer(c_int) function CNTSTRH1BCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Young's modulus depends on R, see [4]. + ! Axial buckling without hysteresis. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: U, dUdL real(c_double), intent(in) :: L, R0, L0 @@ -253,16 +258,16 @@ contains !********************************************************************** E = ( L - L0 ) / L0 K = 86.64d+00 + 100.56d+00 * R0 Kbcl = -10.98d+00 * L0 - if ( E .gt. CNTSTREc ) then !Harmonic stretching + if ( E .gt. CNTSTREc ) then ! Harmonic stretching dUdL = K * E U = 0.5d+00 * L0 * E * dUdL CNTSTRH1BCalc = CNTPOT_STRETCHING - else if ( E .gt. CNTSTREc2 ) then !Axial buckling + else if ( E .gt. CNTSTREc2 ) then ! Axial buckling dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc U = Kbcl * E + dUbcl dUdL = Kbcl / L0 - CNTSTRH1BCalc = CNTPOT_STRETCHING !should be buckling, but doesn't work for some reason... - else !Return to harmonic potential + CNTSTRH1BCalc = CNTPOT_STRETCHING + else ! Return to harmonic potential d = -0.0142794 dUdL = K * ( d + E - CNTSTREc2 ) dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc + Kbcl * CNTSTREc2 @@ -276,7 +281,7 @@ contains !********************************************************************** ! Stretching without fracture, harmonic potential, with axial buckling with hysteresis ! - integer(c_int) function CNTSTRH1BHCalc ( U, dUdL, L, R0, L0, ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function CNTSTRH1BHCalc ( U, dUdL, L, R0, L0, ABF, Ebuc ) !!!!!!!!!!!!!!!!!!! ! Young's modulus depends on R, see [4] !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: U, dUdL, Ebuc @@ -289,18 +294,18 @@ contains !********************************************************************** E = ( L - L0 ) / L0 K = 86.64d+00 + 100.56d+00 * R0 Kbcl = -10.98d+00 * L0 - if ( E .gt. CNTSTREc ) then ! harmonic potential - no buckling + if ( E .gt. CNTSTREc ) then ! Harmonic potential - no buckling dUdL = K * E U = 0.5d+00 * L0 * E * dUdL CNTSTRH1BHCalc = CNTPOT_STRETCHING Ebuc = 0.0d+00 - else if ( E .gt. CNTSTREc1 ) then !above minimal buckling strain, but not at critical strain - if ( ABF .eq. 0 ) then ! not buckled. Continue harmonic potential + else if ( E .gt. CNTSTREc1 ) then ! Above minimal buckling strain, but not at critical strain + if ( ABF .eq. 0 ) then ! Not buckled. Continue harmonic potential dUdL = K * E U = 0.5d+00 * L0 * E * dUdL CNTSTRH1BHCalc = CNTPOT_STRETCHING Ebuc = 0.0d+00 - else ! relaxing from buckled state. Use buckling potential + else ! Relaxing from buckled state. Use buckling potential dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc U = Kbcl * E + dUbcl dUdL = Kbcl / L0 @@ -308,13 +313,13 @@ contains !********************************************************************** Ebuc = 0.0d+00 end if else if( E .gt. CNTSTREc2 ) then ! Axial buckling strain region - if ( ABF .eq. 0 ) then !newly buckled + if ( ABF .eq. 0 ) then ! Newly buckled dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc U = Kbcl * E + dUbcl dUdL = Kbcl / L0 CNTSTRH1BHCalc = CNTPOT_SBUCKLING Ebuc = 0.5d+00 * L0 * K * CNTSTREc1 * CNTSTREc1 - Kbcl * CNTSTREc1 - dUbcl - else ! already buckled + else ! Already buckled dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc U = Kbcl * E + dUbcl dUdL = Kbcl / L0 @@ -333,7 +338,7 @@ contains !********************************************************************** ! Stretching with fracture, non-harmonic potential of type 0 ! - integer(c_int) function CNTSTRNH0FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function CNTSTRNH0FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(out) :: U, dUdL real(c_double), intent(in) :: L, R0, L0 real(c_double) :: E, DE, t @@ -375,7 +380,7 @@ contains !********************************************************************** ! Stretching without fracture, non-harmonic potential of type 1 ! - integer(c_int) function CNTSTRNH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function CNTSTRNH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(out) :: U, dUdL real(c_double), intent(in) :: L, R0, L0 real(c_double) :: E, C, DE, t @@ -400,11 +405,10 @@ contains !********************************************************************** ! Stretching with fracture, non-harmonic potential of type 1 ! - integer(c_int) function CNTSTRNH1FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function CNTSTRNH1FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(out) :: U, dUdL real(c_double), intent(in) :: L, R0, L0 real(c_double) :: E, C, DE, t -!character(c_char)*512 :: Msg !------------------------------------------------------------------------------------------- E = ( L - L0 ) / L0 if ( E < CNTSTREl ) then @@ -418,8 +422,6 @@ contains !********************************************************************** U = CNTSTRUl + CNTSTRAAA * DE - CNTSTRBBB * dlog ( C ) CNTSTRNH1FCalc = CNTPOT_STRETCHING else -!write ( Msg, * ) 'F Strains', E, CNTSTREf -!call PrintStdLogMsg ( Msg ) dUdL = 0.0d+00 U = 0.0d+00 CNTSTRNH1FCalc = CNTPOT_SFRACTURE @@ -452,8 +454,7 @@ contains !********************************************************************** ! General ! - !integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 , ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 , ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(out) :: U, dUdL, Ebuc real(c_double), intent(in) :: L, R0, L0 integer(c_int), intent(in) :: ABF @@ -480,8 +481,6 @@ contains !********************************************************************** subroutine CNTSTRInit ( STRModel, STRParams, YMType, Rref ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer(c_int), intent(in) :: STRModel, STRParams, YMType real(c_double), intent(in) :: Rref - !real(c_double) :: A - !integer(c_int) :: i !------------------------------------------------------------------------------------------- CNTSTRModel = STRModel CNTSTRParams = STRParams @@ -500,15 +499,6 @@ contains !********************************************************************** call CNTSTRNH1Init () end if end if - !CNTSTRAmin = -0.4d+00 - !CNTSTRAmax = 0.4d+00 - !CNTSTRDA = ( CNTSTRAmax - CNTSTRAmin ) / ( CNTPOTN - 1 ) - !A = CNTSTRAmin - !do i = 0, CNTPOTN - 1 - ! CNTSTRU(i) = 0.5d+00 * A * A - ! CNTSTRdUdA(i) = A - ! A = A + CNTSTRDA - !end do end subroutine CNTSTRInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- @@ -516,8 +506,6 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- subroutine BendingGradients ( K, G0, G1, G2, R0, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This functions calculates degreeiest for bending forces - !------------------------------------------------------------------------------------------- real(c_double), intent(inout) :: K real(c_double), dimension(0:2), intent(inout) :: G0, G1, G2 real(c_double), dimension(0:2), intent(in) :: R0, R1, R2 @@ -538,9 +526,8 @@ contains !********************************************************************** G1 = - ( G0 + G2 ) end subroutine BendingGradients !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTBNDHCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Bending model of type 0: - ! Harmonic bending potential + integer(c_int) function CNTBNDHCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Bending model of type 0:Harmonic bending potential. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: U, dUdC real(c_double), intent(in) :: C, R0, L0 @@ -553,9 +540,8 @@ contains !********************************************************************** CNTBNDHCalc = CNTPOT_BENDING end function CNTBNDHCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTBNDHBCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Bending model of type 1: - ! Harmonic bending potential with buckling + integer(c_int) function CNTBNDHBCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Bending model of type 1: Harmonic bending potential with buckling. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: U, dUdC real(c_double), intent(in) :: C, R0, L0 @@ -570,7 +556,8 @@ contains !********************************************************************** Theta= M_PI - acos ( C ) Kbnd = 63.8d+00 * R0**2.93d+00 Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= Kbnd * ( CNTBNDB * ( M_PI - 2.0d+00 * atan ( 2.0 * CNTBNDR / L0 ) ) - 0.5d+00 * L0 / CNTBNDR ) / CNTBNDR + DUbcl= Kbnd * ( CNTBNDB * ( M_PI - 2.0d+00 * atan ( 2.0 * CNTBNDR / L0 ) ) - 0.5d+00 * L0 / CNTBNDR ) & + / CNTBNDR U = Kbcl * abs( Theta )**CNTBNDN - DUbcl dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) CNTBNDHBCalc = CNTPOT_BBUCKLING @@ -582,7 +569,7 @@ contains !********************************************************************** end if end function CNTBNDHBCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTBNDHBFCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function CNTBNDHBFCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(out) :: U, dUdC real(c_double), intent(in) :: C, R0, L0 real(c_double) :: E1, E2, C2, Kbnd, Kbcl, Theta, DUbcl @@ -601,7 +588,8 @@ contains !********************************************************************** else Kbnd = 63.8d+00 * R0**2.93d+00 Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= Kbnd * ( CNTBNDB * ( M_PI - 2.0d+00 * atan ( 2.0 * CNTBNDR / L0 ) ) - 0.5d+00 * L0 / CNTBNDR ) / CNTBNDR + DUbcl= Kbnd * ( CNTBNDB * ( M_PI - 2.0d+00 * atan ( 2.0 * CNTBNDR / L0 ) ) - & + 0.5d+00 * L0 / CNTBNDR ) / CNTBNDR U = Kbcl * abs ( Theta )**CNTBNDN - DUbcl dUdC = Kbcl * CNTBNDN * abs ( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) CNTBNDHBFCalc = CNTPOT_BBUCKLING @@ -614,9 +602,8 @@ contains !********************************************************************** end if end function CNTBNDHBFCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTBNDHBHCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!! - ! Bending model of type 1: - ! Harmonic bending potential with buckling with hysteresis approch. + integer(c_int) function CNTBNDHBHCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!! + ! Bending model of type 1: Harmonic bending potential with buckling with hysteresis approach. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: U, dUdC, Ebuc real(c_double), intent(in) :: C , R0, L0 @@ -636,7 +623,7 @@ contains !********************************************************************** dUdC = 2.0d+00 * Kbnd / ( E1 * E1 ) CNTBNDHBHCalc = CNTPOT_BENDING Ebuc = 0.0 - else if ( C2 .ge. Cmin .and. C2 .lt. CNTBNDC2 ) then !Potential here depends on buckling flag of node + else if ( C2 .ge. Cmin .and. C2 .lt. CNTBNDC2 ) then ! Potential depends on buckling flag of a node if ( BBF .eq. 0 ) then ! Not buckled yet. Continue harmonic bending Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0 U = Kbnd * E2 / E1 @@ -647,7 +634,8 @@ contains !********************************************************************** Theta= M_PI - acos ( C ) Kbnd = 63.8d+00 * R0**2.93d+00 Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN + DUbcl= 2.0d+00*Kbnd * & + (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN U = Kbcl * abs( Theta )**CNTBNDN + DUbcl dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) Ebuc = 0.0d+00 @@ -658,7 +646,8 @@ contains !********************************************************************** Theta= M_PI - acos ( C ) Kbnd = 63.8d+00 * R0**2.93d+00 Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN + DUbcl= 2.0d+00*Kbnd * & + (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN U = Kbcl * abs( Theta )**CNTBNDN + DUbcl dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) Ebuc = 0.0d00 @@ -667,10 +656,12 @@ contains !********************************************************************** Theta= M_PI - acos ( C ) Kbnd = 63.8d+00 * R0**2.93d+00 Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN + DUbcl= 2.0d+00*Kbnd * & + (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN U = Kbcl * abs( Theta )**CNTBNDN + DUbcl dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) - Ebuc = 2.0d+00*Kbnd * (1.0d+00+cos(l0/CNTBNDR+M_PI)) / (1.0d+00-cos(l0/CNTBNDR+M_PI))/L0- Kbcl*abs(l0/CNTBNDR)**CNTBNDN-dUbcl + Ebuc = 2.0d+00*Kbnd * (1.0d+00+cos(l0/CNTBNDR+M_PI)) / (1.0d+00-cos(l0/CNTBNDR+M_PI))/L0 & + - Kbcl * abs ( l0 / CNTBNDR ) ** CNTBNDN - dUbcl CNTBNDHBHCalc = CNTPOT_BBUCKLING end if end if @@ -680,8 +671,7 @@ contains !********************************************************************** ! General ! -! integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(out) :: U, dUdC, Ebuc real(c_double), intent(in) :: C, R0, L0 integer(c_int), intent(in) :: BBF @@ -707,16 +697,6 @@ contains !********************************************************************** CNTBNDModel= BNDModel CNTBNDN1 = CNTBNDN - 1.0d+00 CNTBNDC2 = 1.0d+00 / ( CNTBNDR * CNTBNDR ) - !CNTBNDAmin = -1.0d+00 - !CNTBNDAmax = 0.99d+00 - !CNTBNDDA = ( CNTBNDAmax - CNTBNDAmin ) / ( CNTPOTN - 1 ) - !A = CNTBNDAmin - !do i = 0, CNTPOTN - 1 - ! E = 1.0d+00 - A - ! CNTBNDU(i) = 2.0d+00 * ( 1.0d+00 + A ) / E - ! CNTBNDdUdA(i) = 4.0d+00 / E / E - ! A = A + CNTBNDDA - !end do end subroutine CNTBNDInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- diff --git a/lib/mesont/ExportCNT.f90 b/lib/mesont/ExportCNT.f90 index 5f468edfcc..bd89e2f036 100644 --- a/lib/mesont/ExportCNT.f90 +++ b/lib/mesont/ExportCNT.f90 @@ -13,18 +13,20 @@ ! Contributing author: Maxim Shugaev (UVA), mvs9t@virginia.edu !------------------------------------------------------------------------- -module ExportCNT !******************************************************************************* +module ExportCNT !********************************************************************************** + use iso_c_binding use CNTPot use TPMLib use TubePotMono use TPMForceField - use iso_c_binding, only : c_int, c_double, c_char implicit none + contains + subroutine InitCNTPotModule_(STRModel, STRParams, YMType, BNDModel, Rref) & bind(c, name = "mesont_lib_InitCNTPotModule") - integer(c_int), intent(in) :: STRModel, STRParams, YMType, BNDModel + integer(c_int), intent(in) :: STRModel, STRParams, YMType, BNDModel real(c_double), intent(in) :: Rref call InitCNTPotModule(STRModel, STRParams, YMType, BNDModel, Rref) @@ -38,30 +40,22 @@ contains subroutine TPMInit_(M, N) & bind(c, name = "mesont_lib_TPMInit") - integer(c_int), intent(in) :: M, N + integer(c_int), intent(in) :: M, N call TPMInit(M, N) endsubroutine - subroutine SetTablePath_(TPMSSTPFile_, N1, TPMAFile_, N2) & + subroutine SetTablePath_(TPMFile_, N) & bind(c, name = "mesont_lib_SetTablePath") - integer(c_int), intent(in) :: N1, N2 - character(c_char), intent(in), dimension(N1) :: TPMSSTPFile_ - character(c_char), intent(in), dimension(N2) :: TPMAFile_ + integer(c_int), intent(in) :: N + character(c_char), intent(in), dimension(N) :: TPMFile_ integer :: i - do i = 1, len(TPMSSTPFile) - if (i <= N1) then - TPMSSTPFile(i:i) = TPMSSTPFile_(i) + do i = 1, len(TPMFile) + if (i <= N) then + TPMFile(i:i) = TPMFile_(i) else - TPMSSTPFile(i:i) = ' ' - endif - enddo - do i = 1, len(TPMAFile) - if (i <= N2) then - TPMAFile(i:i) = TPMAFile_(i) - else - TPMAFile(i:i) = ' ' + TPMFile(i:i) = ' ' endif enddo endsubroutine @@ -76,50 +70,81 @@ contains subroutine TubeStretchingForceField_(U1, U2, F1, F2, S1, S2, X1, X2, R12, L12) & bind(c, name = "mesont_lib_TubeStretchingForceField") - real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor - real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segment nodes - real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in) :: L12 ! Equilibrium length of segment (X1,X2) + ! Interaction energies associated with nodes X1 and X2 + real(c_double), intent(inout) :: U1, U2 + ! Forces exerted on nodes X1 and X2 + real(c_double), intent(inout), dimension(0:2) :: F1, F2 + ! Contributions of nodes X1 and X2 to the virial stress tensor + real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 + ! Coordinates of the segment nodes + real(c_double), intent(in), dimension(0:2) :: X1, X2 + ! Radius of a nanotube the segment (X1,X2) belongs to + real(c_double), intent(in) :: R12 + ! Equilibrium length of segment (X1,X2) + real(c_double), intent(in) :: L12 call TubeStretchingForceField(U1, U2, F1, F2, S1, S2, X1, X2, R12, L12) endsubroutine subroutine TubeBendingForceField_(U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2) & bind(c, name = "mesont_lib_TubeBendingForceField") - real(c_double), intent(inout) :: U1, U2, U3 ! Interaction energies associated with nodes X1, X2, and X3 - real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3 ! Forces exerted on nodes X1, X2, and X3 - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3 ! Contributions of nodes X1, X2, and X3 to the virial stress tensor - real(c_double), intent(in), dimension(0:2) :: X1, X2, X3 ! Coordinates of nodes - real(c_double), intent(in) :: R123 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in) :: L123 ! Equilibrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments) - integer(c_int), intent(inout) :: BBF2 + ! Interaction energies associated with nodes X1, X2, and X3 + real(c_double), intent(inout) :: U1, U2, U3 + ! Forces exerted on nodes X1, X2, and X3 + real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3 + ! Contributions of nodes X1, X2, and X3 to the virial stress tensor + real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3 + ! Coordinates of nodes + real(c_double), intent(in), dimension(0:2) :: X1, X2, X3 + ! Radius of nanotube the segment (X1,X2) belongs to + real(c_double), intent(in) :: R123 + ! Equilibrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments) + real(c_double), intent(in) :: L123 + integer(c_int), intent(inout) :: BBF2 call TubeBendingForceField(U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2 ) endsubroutine - subroutine SegmentTubeForceField_(U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType) & + subroutine SegmentTubeForceField_(U1,U2,U,F1,F2,F,Fe,S1,S2,S,Se,X1,X2,R12,N,X,Xe,BBF,R,E1,E2,Ee,TPMType)& bind(c, name = "mesont_lib_SegmentTubeForceField") - integer(c_int), intent(in) :: N ! Number of nodes in array X - real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), intent(inout), dimension(0:N-1) :: U ! Interaction energies associated with nodes X - real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2,0:N-1) :: F ! Forces exerted on nodes X - real(c_double), intent(inout), dimension(0:2) :: Fe ! Force exerted on node Xe (can be updated only if Ee > 0) - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor - real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S ! Contributions of nodes X to the virial stress tensor - real(c_double), intent(inout), dimension(0:2,0:2) :: Se ! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0) - real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segment nodes - real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in), dimension(0:2,0:N-1) :: X ! Coordinates of the nanotube nodes - real(c_double), intent(in), dimension(0:2) :: Xe ! Additional node of the extended chain if Ee > 0 - integer(c_int), intent(in), dimension(0:N-1) :: BBF ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i) - real(c_double), intent(in) :: R ! Radius of nanotube X - integer(c_int), intent(in) :: E1, E2 ! E1 = 1 if the chain node 0 is a CNT end; E2 = 1 if the chain node N-1 is a CNT end; - integer(c_int), intent(in) :: Ee ! Parameter defining the type of the extended chain (0,1,2) - integer(c_int), intent(in) :: TPMType ! Type of the tubular potential (0 or 1) + ! Number of nodes in array X + integer(c_int), intent(in) :: N + ! Interaction energies associated with nodes X1 and X2 + real(c_double), intent(inout) :: U1, U2 + ! Interaction energies associated with nodes X + real(c_double), intent(inout), dimension(0:N-1) :: U + ! Forces exerted on nodes X1 and X2 + real(c_double), intent(inout), dimension(0:2) :: F1, F2 + ! Forces exerted on nodes X + real(c_double), intent(inout), dimension(0:2,0:N-1) :: F + ! Force exerted on node Xe (can be updated only if Ee > 0) + real(c_double), intent(inout), dimension(0:2) :: Fe + ! Contributions of nodes X1 and X2 to the virial stress tensor + real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 + ! Contributions of nodes X to the virial stress tensor + real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S + ! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0) + real(c_double), intent(inout), dimension(0:2,0:2) :: Se + ! Coordinates of the segment nodes + real(c_double), intent(in), dimension(0:2) :: X1, X2 + ! Radius of nanotube the segment (X1,X2) belongs to + real(c_double), intent(in) :: R12 + ! Coordinates of the nanotube nodes + real(c_double), intent(in), dimension(0:2,0:N-1) :: X + ! Additional node of the extended chain if Ee > 0 + real(c_double), intent(in), dimension(0:2) :: Xe + ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i) + integer(c_int), intent(in), dimension(0:N-1) :: BBF + ! Radius of nanotube X + real(c_double), intent(in) :: R + ! E1 = 1 if the chain node 0 is a CNT end; E2 = 1 if the chain node N-1 is a CNT end; + integer(c_int), intent(in) :: E1, E2 + ! Parameter defining the type of the extended chain (0,1,2) + integer(c_int), intent(in) :: Ee + ! Type of the tubular potential (0 or 1) + integer(c_int), intent(in) :: TPMType call SegmentTubeForceField(U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType) endsubroutine -endmodule ExportCNT !************************************************************************** + +endmodule ExportCNT !******************************************************************************* diff --git a/lib/mesont/Install.py b/lib/mesont/Install.py index ffe709d44c..284ef6888b 100644 --- a/lib/mesont/Install.py +++ b/lib/mesont/Install.py @@ -1 +1,97 @@ -../Install.py \ No newline at end of file +#!/usr/bin/env python + +""" +Install.py tool to do a generic build of a library +soft linked to by many of the lib/Install.py files +used to automate the steps described in the corresponding lib/README +""" + +from __future__ import print_function +import sys, os, subprocess +from argparse import ArgumentParser + +sys.path.append('..') +from install_helpers import get_cpus, fullpath + +parser = ArgumentParser(prog='Install.py', + description="LAMMPS library build wrapper script") + +HELP = """ +Syntax from src dir: make lib-libname args="-m machine -e suffix" +Syntax from lib dir: python Install.py -m machine -e suffix + +libname = name of lib dir (e.g. atc, h5md, meam, poems, etc) +specify -m and optionally -e, order does not matter + +Examples: + +make lib-poems args="-m serial" # build POEMS lib with same settings as in the serial Makefile in src +make lib-colvars args="-m mpi" # build USER-COLVARS lib with same settings as in the mpi Makefile in src +make lib-meam args="-m ifort" # build MEAM lib with custom Makefile.ifort (using Intel Fortran) +""" + +# parse and process arguments + +parser.add_argument("-m", "--machine", + help="suffix of a /Makefile.* file used for compiling this library") +parser.add_argument("-e", "--extramake", + help="set EXTRAMAKE variable in /Makefile. to Makefile.lammps.") + +args = parser.parse_args() + +# print help message and exit, if neither build nor path options are given +if not args.machine and not args.extramake: + parser.print_help() + sys.exit(HELP) + +machine = args.machine +extraflag = args.extramake +if extraflag: + suffix = args.extramake +else: + suffix = 'empty' + +# set lib from working dir + +cwd = fullpath('.') +lib = os.path.basename(cwd) + +# create Makefile.auto as copy of Makefile.machine +# reset EXTRAMAKE if requested + +if not os.path.exists("Makefile.%s" % machine): + sys.exit("lib/%s/Makefile.%s does not exist" % (lib, machine)) + +lines = open("Makefile.%s" % machine, 'r').readlines() +fp = open("Makefile.auto", 'w') + +has_extramake = False +for line in lines: + words = line.split() + if len(words) == 3 and words[0] == "EXTRAMAKE" and words[1] == '=': + has_extramake = True + if extraflag: + line = line.replace(words[2], "Makefile.lammps.%s" % suffix) + fp.write(line) + +fp.close() + +# make the library via Makefile.auto optionally with parallel make +n_cpus = get_cpus() + +print("Building lib%s.a ..." % lib) +cmd = "make -f Makefile.auto clean; make -f Makefile.auto -j%d" % n_cpus +try: + txt = subprocess.check_output(cmd, shell=True, stderr=subprocess.STDOUT) + print(txt.decode('UTF-8')) +except subprocess.CalledProcessError as e: + print("Make failed with:\n %s" % e.output.decode('UTF-8')) + sys.exit(1) + +if os.path.exists("lib%s.a" % lib): + print("Build was successful") +else: + sys.exit("Build of lib/%s/lib%s.a was NOT successful" % (lib, lib)) + +if has_extramake and not os.path.exists("Makefile.lammps"): + print("WARNING: lib/%s/Makefile.lammps was NOT created" % lib) diff --git a/lib/mesont/LinFun2.f90 b/lib/mesont/LinFun2.f90 index f6aa9bf75d..5ced49e531 100644 --- a/lib/mesont/LinFun2.f90 +++ b/lib/mesont/LinFun2.f90 @@ -15,7 +15,7 @@ module LinFun2 !************************************************************************************ ! -! TMD Library: Bi-linear functions and their derivatives +! Bi-linear functions and their derivatives. ! !--------------------------------------------------------------------------------------------------- ! @@ -29,7 +29,7 @@ implicit none contains !****************************************************************************************** - real(c_double) function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer(c_int), intent(in) :: i, N real(c_double), intent(in) :: X real(c_double), dimension(0:N-1), intent(in) :: P diff --git a/lib/mesont/Makefile.gfortran b/lib/mesont/Makefile.gfortran index e6b8be2a43..a8a5c1e942 100644 --- a/lib/mesont/Makefile.gfortran +++ b/lib/mesont/Makefile.gfortran @@ -21,7 +21,6 @@ OBJ = $(SRC:.f90=.o) F90 = gfortran CC = gcc F90FLAGS = -O3 -fPIC -ffast-math -ftree-vectorize -fexpensive-optimizations -fno-second-underscore -g -ffree-line-length-none -#F90FLAGS = -O ARCHIVE = ar ARCHFLAG = -rc LINK = g++ @@ -46,7 +45,7 @@ lib: $(OBJ) %.o:%.c $(CC) $(F90FLAGS) -c $< -#include .depend +include .depend # ------ CLEAN ------ clean: diff --git a/lib/mesont/Makefile.ifort b/lib/mesont/Makefile.ifort index 09c39dd69d..fa912d9e4b 100644 --- a/lib/mesont/Makefile.ifort +++ b/lib/mesont/Makefile.ifort @@ -42,7 +42,7 @@ lib: $(OBJ) %.o:%.c $(CC) $(F90FLAGS) -c $< -#include .depend +include .depend # ------ CLEAN ------ clean: diff --git a/lib/mesont/Makefile.serial b/lib/mesont/Makefile.serial index c52fbcb986..a8a5c1e942 100644 --- a/lib/mesont/Makefile.serial +++ b/lib/mesont/Makefile.serial @@ -1 +1,55 @@ -Makefile.gfortran \ No newline at end of file +SHELL = /bin/sh + +# which file will be copied to Makefile.lammps + +EXTRAMAKE = Makefile.lammps.gfortran + +# ------ FILES ------ + +SRC = LinFun2.f90 Spline1.f90 Spline2.f90 TPMLib.f90 TPMGeom.f90 TubePotBase.f90 TubePotTrue.f90 \ + TubePotMono.f90 TPMM0.f90 TPMM1.f90 CNTPot.f90 TPMForceField.f90 ExportCNT.f90 + +FILES = $(SRC) Makefile + +# ------ DEFINITIONS ------ + +LIB = libmesont.a +OBJ = $(SRC:.f90=.o) + +# ------ SETTINGS ------ + +F90 = gfortran +CC = gcc +F90FLAGS = -O3 -fPIC -ffast-math -ftree-vectorize -fexpensive-optimizations -fno-second-underscore -g -ffree-line-length-none +ARCHIVE = ar +ARCHFLAG = -rc +LINK = g++ +LINKFLAGS = -O +USRLIB = +SYSLIB = + +# ------ MAKE PROCEDURE ------ + +lib: $(OBJ) + $(ARCHIVE) $(ARFLAGS) $(LIB) $(OBJ) + @cp $(EXTRAMAKE) Makefile.lammps + +# ------ COMPILE RULES ------ + +%.o:%.F + $(F90) $(F90FLAGS) -c $< + +%.o:%.f90 + $(F90) $(F90FLAGS) -c $< + +%.o:%.c + $(CC) $(F90FLAGS) -c $< + +include .depend +# ------ CLEAN ------ + +clean: + -rm *.o *.mod $(LIB) + +tar: + -tar -cvf ../MESONT.tar $(FILES) \ No newline at end of file diff --git a/lib/mesont/Spline1.f90 b/lib/mesont/Spline1.f90 index ae1a51dc77..47acbecb70 100644 --- a/lib/mesont/Spline1.f90 +++ b/lib/mesont/Spline1.f90 @@ -15,7 +15,7 @@ module Spline1 !************************************************************************************ ! -! TMD Library: One-dimensional cubic spline function +! One-dimensional cubic spline function. ! !--------------------------------------------------------------------------------------------------- ! @@ -29,14 +29,15 @@ implicit none contains !****************************************************************************************** - real(c_double) function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!!! + real(c_double) function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!! real(c_double), intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 real(c_double) :: H26, HL, HR !------------------------------------------------------------------------------------------- H26 = Hi_1 * Hi_1 / 6.0 Hl = X - Xi_1 Hr = Xi - X - ValueSpline1_0 = ( ( Mi_1 * Hr * Hr * Hr + Mi * Hl * Hl * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * Hr + ( Yi - Mi * H26 ) * Hl ) / Hi_1 + ValueSpline1_0 = ( ( Mi_1 * Hr * Hr * Hr + Mi * Hl * Hl * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * Hr & + + ( Yi - Mi * H26 ) * Hl ) / Hi_1 end function ValueSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine ValueSpline1_1 ( S, S1, X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!! @@ -55,9 +56,6 @@ contains !********************************************************************** end subroutine ValueSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine sprogonka3 ( N, K0, K1, K2, F, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! K0[i] * X[i-1] + K1[i] * X[I] + K2[i] * X[i+1] = F[i] - ! i = 0..(N-1) - !------------------------------------------------------------------------------------------- integer(c_int), intent(in) :: N real(c_double), dimension(0:N-1), intent(in) :: K0, K1, K2 real(c_double), dimension(0:N-1), intent(inout) :: F, X @@ -124,7 +122,7 @@ contains !********************************************************************** call sprogonka3 ( N, K0, K1, K2, D, M ) end subroutine CreateSpline1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer(c_int), intent(in) :: i, N real(c_double), intent(in) :: X real(c_double), dimension(0:N-1), intent(in) :: P, F, M @@ -141,7 +139,8 @@ contains !********************************************************************** HR2 = HR * HR HLH = HL / H HRH = HR / H - CalcSpline1_0 = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH + CalcSpline1_0 = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH & + + ( F(i) - M(i) * H26 ) * HLH end function CalcSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CalcSpline1_1 ( S, S1, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -162,8 +161,8 @@ contains !********************************************************************** HR2 = HR * HR HLH = HL / H HRH = HR / H - S = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH - S1 = ( ( M(i) * HL2 - M(j) * HR2 ) / 2.0d+00 + F(i) - F(j) ) / H - H6 * ( M(i) - M(j) ) + S = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH + S1 = ( ( M(i) * HL2 - M(j) * HR2 ) / 2.0d+00 + F(i) - F(j) ) / H - H6 * ( M(i) - M(j) ) end subroutine CalcSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CalcSpline1_2 ( S, S1, S2, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -184,9 +183,9 @@ contains !********************************************************************** HR2 = HR * HR HLH = HL / H HRH = HR / H - S = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH - S1 = ( ( M(i) * HL2 - M(j) * HR2 ) / 2.0d+00 + F(i) - F(j) ) / H - H6 * ( M(i) - M(j) ) - S2 = M(j) * HRH + M(i) * HLH + S = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH + S1 = ( ( M(i) * HL2 - M(j) * HR2 ) / 2.0d+00 + F(i) - F(j) ) / H - H6 * ( M(i) - M(j) ) + S2 = M(j) * HRH + M(i) * HLH end subroutine CalcSpline1_2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module Spline1 !******************************************************************************** diff --git a/lib/mesont/Spline2.f90 b/lib/mesont/Spline2.f90 index 720d73f553..883a5cbbee 100644 --- a/lib/mesont/Spline2.f90 +++ b/lib/mesont/Spline2.f90 @@ -15,7 +15,7 @@ module Spline2 !************************************************************************************ ! -! TMD Library: Two-dimensional cubic spline function +! Two-dimensional cubic spline function. ! !--------------------------------------------------------------------------------------------------- ! @@ -32,12 +32,12 @@ implicit none contains !****************************************************************************************** subroutine CreateSpline2 ( CL, CD, CR, CU, N1, N2, N, P1, P2, F, Fxx, Fyy, Fxxyy, FF, MM, DD, K0, K1, K2 ) - integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N2, N + integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N2, N real(c_double), dimension(0:N1-1), intent(in) :: P1 real(c_double), dimension(0:N2-1), intent(in) :: P2 real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy real(c_double), dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2 - integer(c_int) :: II + integer(c_int) :: II !------------------------------------------------------------------------------------------- do II = 0, N2 - 1 FF(0:N1-1) = F(0:N1-1,II) @@ -69,12 +69,12 @@ contains !********************************************************************** end subroutine CreateSpline2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CreateSpline2Ext ( CL, CD, CR, CU, N1, N1A, N2, N2A, N, P1, P2, F, Fxx, Fyy, Fxxyy, FF, MM, DD, K0, K1, K2 ) - integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N1A, N2, N2A, N + integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N1A, N2, N2A, N real(c_double), dimension(0:N1-1), intent(in) :: P1 real(c_double), dimension(0:N2-1), intent(in) :: P2 real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy real(c_double), dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2 - integer(c_int) :: II + integer(c_int) :: II !------------------------------------------------------------------------------------------- Fxx = 0.0d+00 Fyy = 0.0d+00 @@ -142,13 +142,13 @@ contains !********************************************************************** end subroutine CreateSpline2Ext !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function CalcSpline2_0 ( i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!!!!!!!!! - integer(c_int), intent(in) :: i, j, N1, N2 + real(c_double) function CalcSpline2_0 ( i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!! + integer(c_int), intent(in) :: i, j, N1, N2 real(c_double), intent(in) :: X, Y real(c_double), dimension(0:N1-1), intent(in) :: P1 real(c_double), dimension(0:N2-1), intent(in) :: P2 real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy - integer(c_int) :: i1, j1 + integer(c_int) :: i1, j1 real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1 !------------------------------------------------------------------------------------------- i1 = i - 1 @@ -163,12 +163,12 @@ contains !********************************************************************** subroutine CalcSpline2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!! real(c_double), intent(out) :: S, Sx1, Sy1 - integer(c_int), intent(in) :: i, j, N1, N2 + integer(c_int), intent(in) :: i, j, N1, N2 real(c_double), intent(in) :: X, Y real(c_double), dimension(0:N1-1), intent(in) :: P1 real(c_double), dimension(0:N2-1), intent(in) :: P2 real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy - integer(c_int) :: i1, j1 + integer(c_int) :: i1, j1 real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1 real(c_double) :: Gyy_0, Gyy_1, Gxxyy_0, Gxxyy_1 !------------------------------------------------------------------------------------------- diff --git a/lib/mesont/TPMForceField.f90 b/lib/mesont/TPMForceField.f90 index b53b2ee7d8..37f66e0014 100644 --- a/lib/mesont/TPMForceField.f90 +++ b/lib/mesont/TPMForceField.f90 @@ -13,15 +13,15 @@ ! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu !------------------------------------------------------------------------- -module TPMForceField !************************************************************************************ +module TPMForceField !****************************************************************************** ! -! TMD Library: Calculation of the TMD force field +! Calculation of the TMD force field ! !--------------------------------------------------------------------------------------------------- ! ! PGI Fortran, Intel Fortran ! -! Alexey N. Volkov, University of Alabama (avolkov1@ua.edu), Version 09.01.33, 2018 +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, version 09.01, 2020 ! !*************************************************************************************************** @@ -34,12 +34,18 @@ implicit none contains !****************************************************************************************** subroutine TubeStretchingForceField ( U1, U2, F1, F2, S1, S2, X1, X2, R12, L12 ) !!!!!!!!!!! - real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor - real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes - real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in) :: L12 ! Equilubrium length of segment (X1,X2) + ! Interaction energies associated with nodes X1 and X2 + real(c_double), intent(inout) :: U1, U2 + ! Forces exerted on nodes X1 and X2 + real(c_double), intent(inout), dimension(0:2) :: F1, F2 + ! Contributions of nodes X1 and X2 to the virial stress tensor + real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 + ! Coordinates of the segment nodes + real(c_double), intent(in), dimension(0:2) :: X1, X2 + ! Radius of a nanotube the segment (X1,X2) belongs to + real(c_double), intent(in) :: R12 + ! Equilibrium length of segment (X1,X2) + real(c_double), intent(in) :: L12 !------------------------------------------------------------------------------------------- integer(c_int) :: ii, jj, Event real(c_double) :: U, F, LL, S, Ubcl @@ -69,15 +75,21 @@ contains !********************************************************************** end subroutine TubeStretchingForceField !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TubeBendingForceField ( U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2 ) - real(c_double), intent(inout) :: U1, U2, U3 ! Interaction energies associated with nodes X1, X2, and X3 - real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3 ! Forces exerted on nodes X1, X2, and X3 - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3 ! Contributions of nodes X1, X2, and X3 to the virial stress tensor - real(c_double), intent(in), dimension(0:2) :: X1, X2, X3 ! Coordinates of nodes - real(c_double), intent(in) :: R123 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in) :: L123 ! Equilubrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments) - integer(c_int), intent(inout) :: BBF2 + ! Interaction energies associated with nodes X1, X2, and X3 + real(c_double), intent(inout) :: U1, U2, U3 + ! Forces exerted on nodes X1, X2, and X3 + real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3 + ! Contributions of nodes X1, X2, and X3 to the virial stress tensor + real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3 + ! Coordinates of nodes + real(c_double), intent(in), dimension(0:2) :: X1, X2, X3 + ! Radius of nanotube the segment (X1,X2) belongs to + real(c_double), intent(in) :: R123 + ! Equilibrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments) + real(c_double), intent(in) :: L123 + integer(c_int), intent(inout) :: BBF2 !------------------------------------------------------------------------------------------- - integer(c_int) :: ii, jj, Event + integer(c_int) :: ii, jj, Event real(c_double) :: U, F, K, S, Ubcl real(c_double), dimension(0:2) :: G0, G1, G2 !------------------------------------------------------------------------------------------- @@ -115,67 +127,81 @@ contains !********************************************************************** end subroutine TubeBendingForceField !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! The purpose of subroutine SegmentTubeForceField is to calculate interaction forces - ! (as well potential nergies and componets of the virial stress tensor) between a segment - ! (X1,X2) and a sequence of segments with node coordinates that belongs to a single CNT + ! (as well potential energies and components of the virial stress tensor) between a segment + ! (X1,X2) and a sequence of segments which belongs to a single CNT. ! It is assumed that X contains ALL nodes of a single CNT that are included into the - ! neighbor list of segment (X1,X2) + ! neighbor list of segment (X1,X2). - ! The nodes in X are assumed to be ordered according to their physical appearence in the nanotube - ! It means that (X(i),X(i+1)) are either correspond to a real segment or divided by a segments + ! The nodes in X are assumed to be ordered according to their physical appearance in the nanotube. + ! It means that (X(i),X(i+1)) are either correspond to a real segment or divided by segments ! that do not belong to a nanotube. - ! Concept of the extendend chain: - ! Let's consider a sequant of nodes (X1,X2,...,XN) forming continuous part of a nanotube. - ! If node Xe preceeds X1 and Xe is the nanotube end, then the extended chain is (Xe,X1,...,XN) and Ee = 1. + ! Concept of the extended chain: + ! Let's consider a sequence of nodes (X1,X2,...,XN) forming continuous part of a nanotube. + ! If node Xe precedes X1 and Xe is the nanotube end, then the extended chain is (Xe,X1,...,XN) and Ee = 1. ! If node Xe follows XN and Xe is the nanotube end, then the extended chain is (X1,...,XN,Xe) and Ee = 2. - ! In all other cases, extended chain coincides with (X1,...,XN) and Ee = 0 - ! If the extended chain contains additional node, then non-zero force is exterted on this node + ! In all other cases, the extended chain coincides with (X1,...,XN) and Ee = 0. + ! If the extended chain contains additional node, then non-zero force is exerted on this node. - subroutine SegmentTubeForceField ( U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType ) - integer(c_int), intent(in) :: N ! Number of nodes in array X - real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), intent(inout), dimension(0:N-1) :: U ! Interaction energies associated with nodes X - real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2,0:N-1) :: F ! Forces exerted on nodes X - real(c_double), intent(inout), dimension(0:2) :: Fe ! Force exerted on node Xe (can be updated only if Ee > 0) - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor - real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S ! Contributions of nodes X to the virial stress tensor - real(c_double), intent(inout), dimension(0:2,0:2) :: Se ! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0) - real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes - real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in), dimension(0:2,0:N-1) :: X ! Coordinates of the nanotube nodes - real(c_double), intent(in), dimension(0:2) :: Xe ! Additiona node of the extended chain if Ee > 0 - integer(c_int), intent(in), dimension(0:N-1) :: BBF ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i) - real(c_double), intent(in) :: R ! Radius of nanotube X - integer(c_int), intent(in) :: E1, E2 ! E1 = 1 if the chnane node 0 is a CNT end; E1 = 2 if the chnane node N-1 is a CNT end; - integer(c_int), intent(in) :: Ee ! Parameter defining the type of the extended chain (0,1,2) - integer(c_int), intent(in) :: TPMType ! Type of the tubular potential (0 or 1) + subroutine SegmentTubeForceField ( U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe,& + BBF, R, E1, E2, Ee, TPMType ) + ! Number of nodes in array X + integer(c_int), intent(in) :: N + ! Interaction energies associated with nodes X1 and X2 + real(c_double), intent(inout) :: U1, U2 + ! Interaction energies associated with nodes X + real(c_double), intent(inout), dimension(0:N-1) :: U + ! Forces exerted on nodes X1 and X2 + real(c_double), intent(inout), dimension(0:2) :: F1, F2 + ! Forces exerted on nodes X + real(c_double), intent(inout), dimension(0:2,0:N-1) :: F + ! Force exerted on node Xe (can be updated only if Ee > 0) + real(c_double), intent(inout), dimension(0:2) :: Fe + ! Contributions of nodes X1 and X2 to the virial stress tensor + real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 + ! Contributions of nodes X to the virial stress tensor + real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S + ! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0) + real(c_double), intent(inout), dimension(0:2,0:2) :: Se + ! Coordinates of the segment nodes + real(c_double), intent(in), dimension(0:2) :: X1, X2 + ! Radius of a nanotube the segment (X1,X2) belongs to + real(c_double), intent(in) :: R12 + ! Coordinates of the nanotube nodes + real(c_double), intent(in), dimension(0:2,0:N-1) :: X + ! Additional node of the extended chain if Ee > 0 + real(c_double), intent(in), dimension(0:2) :: Xe + ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i) + integer(c_int), intent(in), dimension(0:N-1) :: BBF + ! Radius of nanotube X + real(c_double), intent(in) :: R + ! E1 = 1 if the chain node 0 is a CNT end; E1 = 2 if the chain node N-1 is a CNT end + integer(c_int), intent(in) :: E1, E2 + ! Parameter defining the type of the extended chain (0,1,2) + integer(c_int), intent(in) :: Ee + ! Type of the tubular potential (0 or 1) + integer(c_int), intent(in) :: TPMType !------------------------------------------------------------------------------------------- - integer(c_int) :: k, ii, jj, IntSign - integer(c_int) :: BType, EType, LocalTPMType + integer(c_int) :: k, ii, jj, IntSign + integer(c_int) :: BType, EType, LocalTPMType real(c_double), dimension(0:2,0:N-1) :: G1, G2 real(c_double), dimension(0:N-1) :: QQ - logical :: EType1, EType2 + logical :: EType1, EType2 real(c_double), dimension(0:2) :: G, DG, DQ, XX real(c_double) :: UT, DR, DS, DS1 - real(c_double) :: xU1, xU2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), dimension(0:N-1) :: xU ! Interaction energies associated with nodes X - real(c_double), dimension(0:2) :: xF1, xF2 ! Forces exerted on nodes X1 and X2 - real(c_double), dimension(0:2,0:N-1) :: xF ! Forces exerted on nodes X - real(c_double), dimension(0:2) :: xFe ! Force exerted on node Xe (can be updated only if Ee > 0) + ! Interaction energies associated with nodes X1 and X2 + real(c_double) :: xU1, xU2 + ! Interaction energies associated with nodes X + real(c_double), dimension(0:N-1) :: xU + ! Forces exerted on nodes X1 and X2 + real(c_double), dimension(0:2) :: xF1, xF2 + ! Forces exerted on nodes X + real(c_double), dimension(0:2,0:N-1) :: xF + ! Force exerted on node Xe (can be updated only if Ee > 0) + real(c_double), dimension(0:2) :: xFe !------------------------------------------------------------------------------------------- - !U1 = 0.0d+00 - !U2 = 0.0d+00 - !U = 0.0d+00 - !F1 = 0.0d+00 - !F2 = 0.0d+00 - !F = 0.0d+00 - !S1 = 0.0d+00 - !S2 = 0.0d+00 - !S = 0.0d+00 - ! Looking for a buckling point BType = 0 do k = 0, N - 1 @@ -192,12 +218,12 @@ contains !********************************************************************** LocalTPMType = 0 EType = 0 else - if ( E1 == 1 ) then ! First node in the chain is the tube end + if ( E1 == 1 ) then ! The first node in the chain is the tube end EType1 = .true. else EType1 = .false. end if - if ( E2 == 1 ) then ! Last node in the chain is the tube end + if ( E2 == 1 ) then ! The last node in the chain is the tube end EType2 = .true. else EType2 = .false. @@ -220,9 +246,9 @@ contains !********************************************************************** IntSign = TPMInteractionFW0 ( QQ, UT, xU1, xU2, xU, xF1, xF2, xF, G1, G2, X1, X2, N, N, X ) else if ( EType == 0 ) then - if ( Ee == 1 ) then ! First node in the extended chain is the tube end + if ( Ee == 1 ) then ! The first node in the extended chain is the tube end EType = 3 - else if ( Ee == 2 ) then ! Last node in the extended chain is the tube end + else if ( Ee == 2 ) then ! The last node in the extended chain is the tube end EType = 4 end if end if diff --git a/lib/mesont/TPMGeom.f90 b/lib/mesont/TPMGeom.f90 index 3925bb47cd..c866512b90 100644 --- a/lib/mesont/TPMGeom.f90 +++ b/lib/mesont/TPMGeom.f90 @@ -15,7 +15,7 @@ module TPMGeom !************************************************************************************ ! -! TMD Library: Geometry functions +! Geometry functions. ! !--------------------------------------------------------------------------------------------------- ! @@ -46,25 +46,21 @@ implicit none real(c_double) :: DomLXhalf, DomLYhalf, DomLZhalf ! Boundary conditions - integer(c_int) :: BC_X = 0 - integer(c_int) :: BC_Y = 0 - integer(c_int) :: BC_Z = 0 + integer(c_int) :: BC_X = 0 + integer(c_int) :: BC_Y = 0 + integer(c_int) :: BC_Z = 0 ! Skin parameter in NBL and related algorithms - real(c_double) :: Rskin = 1.0d+00 + real(c_double) :: Rskin = 1.0d+00 contains !****************************************************************************************** subroutine ApplyPeriodicBC ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This subroutine changes coortinates of the point accorning to periodic boundary conditions - ! it order to makesure that the point is inside the computational cell + ! This subroutine changes coordinates of the point according to the periodic boundary conditions + ! it order to make sure that the point is inside the computational cell, !------------------------------------------------------------------------------------------- real(c_double), dimension(0:2), intent(inout) :: R !------------------------------------------------------------------------------------------- - ! These commented lines implemment the more general, but less efficient algorithm - !if ( BC_X == 1 ) R(0) = R(0) - DomLX * roundint ( R(0) / DomLX ) - !if ( BC_Y == 1 ) R(1) = R(1) - DomLY * roundint ( R(1) / DomLY ) - !if ( BC_Z == 1 ) R(2) = R(2) - DomLZ * roundint ( R(2) / DomLZ ) if ( BC_X == 1 ) then if ( R(0) .GT. DomLXHalf ) then R(0) = R(0) - DomLX @@ -89,8 +85,8 @@ contains !********************************************************************** end subroutine ApplyPeriodicBC !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine LinePoint ( Displacement, Q, R1, L1, R0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function calculates the point Q of projection of point R0 on line (R1,L1) - ! Q = R1 + Disaplacement * L1 + ! This function calculates the point Q of projection of point R0 onto line (R1,L1). + ! Q = R1 + Displacement * L1. !------------------------------------------------------------------------------------------- real(c_double), intent(inout) :: Displacement real(c_double), dimension(0:2), intent(inout) :: Q @@ -103,18 +99,18 @@ contains !********************************************************************** Q = R1 + Displacement * L1 end subroutine LinePoint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!!!!!!! - ! This function determines the neares distance H between two lines (R1,L1) and (R2,L2) + integer(c_int) function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!! + ! This function determines the smallest distance H between two lines (R1,L1) and (R2,L2). !------------------------------------------------------------------------------------------- ! Input values: - ! R1, L1, point and direction of line 1 - ! R2, L2, point and direction of line 2 - ! Prec, precision for the case L1 * L2 = 0 (parallel lines) + ! R1, L1, point and direction of line 1. + ! R2, L2, point and direction of line 2. + ! Prec, precision for the case L1 * L2 = 0 (parallel lines). ! Return values: - ! H, minimal distance between lines - ! cosA, cosine of angle between lines - ! D1, D2, displacemets - ! L12, unit vector directed along the closes distance + ! H, minimum distance between lines. + ! cosA, cosine of the angle between lines. + ! D1, D2, displacements. + ! L12, unit vector directed along the closest distance. !------------------------------------------------------------------------------------------- real(c_double), intent(inout) :: H, cosA, D1, D2 real(c_double), dimension(0:2), intent(out) :: L12 @@ -132,7 +128,7 @@ contains !********************************************************************** end if LineLine = MD_LINES_NONPAR R = R2 - R1 - ! Here we take into account periodic boundaries + ! Here we take into account periodic boundary conditions call ApplyPeriodicBC ( R ) DD1 = S_V3xV3 ( R, L1 ) DD2 = S_V3xV3 ( R, L2 ) @@ -141,7 +137,7 @@ contains !********************************************************************** Q1 = R1 - D1 * L1 Q2 = R2 - D2 * L2 L12 = Q2 - Q1 - ! Here we take into account periodic boundaries + ! Here we take into account periodic boundary conditions call ApplyPeriodicBC ( L12 ) H = S_V3norm3 ( L12 ) if ( H < Prec ) then ! Lines intersect each other diff --git a/lib/mesont/TPMLib.f90 b/lib/mesont/TPMLib.f90 index 9e4be87814..e35f75e917 100644 --- a/lib/mesont/TPMLib.f90 +++ b/lib/mesont/TPMLib.f90 @@ -15,7 +15,7 @@ module TPMLib !************************************************************************************* ! -! TMD Library: Basic constants, types, and mathematical functions +! Basic constants, types, and mathematical functions. ! !--------------------------------------------------------------------------------------------------- ! @@ -41,20 +41,20 @@ implicit none ! Physical unit constants !--------------------------------------------------------------------------------------------------- - real(c_double), parameter :: K_AMU = 1.66056E-27 ! a.m.u. (atomic mass unit, Dalton) - real(c_double), parameter :: K_EV = 1.60217646e-19 ! eV (electron-volt) + real(c_double), parameter :: K_AMU = 1.66056E-27 ! a.m.u. (atomic mass unit, Dalton) + real(c_double), parameter :: K_EV = 1.60217646e-19 ! eV (electron-volt) - real(c_double), parameter :: K_MDLU = 1.0E-10 ! MD length unit (m) - real(c_double), parameter :: K_MDEU = K_EV ! MD energy unit (J) - real(c_double), parameter :: K_MDMU = K_AMU ! MD mass unit (kg) - real(c_double), parameter :: K_MDFU = K_MDEU / K_MDLU ! MD force unit (N) - real(c_double), parameter :: K_MDCU = K_MDEU / K_MDMU ! MD specific heat unit (J/(kg*K)) + real(c_double), parameter :: K_MDLU = 1.0E-10 ! MD length unit (m) + real(c_double), parameter :: K_MDEU = K_EV ! MD energy unit (J) + real(c_double), parameter :: K_MDMU = K_AMU ! MD mass unit (kg) + real(c_double), parameter :: K_MDFU = K_MDEU / K_MDLU ! MD force unit (N) + real(c_double), parameter :: K_MDCU = K_MDEU / K_MDMU ! MD specific heat unit (J/(kg*K)) !--------------------------------------------------------------------------------------------------- ! Global variables !--------------------------------------------------------------------------------------------------- - integer(c_int) :: StdUID = 31 + integer(c_int) :: StdUID = 31 contains !****************************************************************************************** @@ -62,19 +62,19 @@ contains !********************************************************************** ! Simple mathematical functions !--------------------------------------------------------------------------------------------------- - real(c_double) function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: X !------------------------------------------------------------------------------------------- rad = X * M_PI_180 end function rad !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: X !------------------------------------------------------------------------------------------- sqr = X * X end function sqr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: X !------------------------------------------------------------------------------------------- if ( X > 0 ) then @@ -90,27 +90,25 @@ contains !********************************************************************** ! Vector & matrix functions !--------------------------------------------------------------------------------------------------- - real(c_double) function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), dimension(0:2), intent(in) :: V !------------------------------------------------------------------------------------------- S_V3xx = V(0) * V(0) + V(1) * V(1) + V(2) * V(2) end function S_V3xx !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function S_V3xV3 ( V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function S_V3xV3 ( V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), dimension(0:2), intent(in) :: V1, V2 !------------------------------------------------------------------------------------------- S_V3xV3 = V1(0) * V2(0) + V1(1) * V2(1) + V1(2) * V2(2) end function S_V3xV3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function S_V3norm3 ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function S_V3norm3 ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), dimension(0:2), intent(in) :: V !------------------------------------------------------------------------------------------- S_V3norm3 = dsqrt ( V(0) * V(0) + V(1) * V(1) + V(2) * V(2) ) end function S_V3norm3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine V3_ort ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Vector production - !------------------------------------------------------------------------------------------- real(c_double), dimension(0:2), intent(inout) :: V !------------------------------------------------------------------------------------------- real(c_double) :: Vabs @@ -122,8 +120,6 @@ contains !********************************************************************** end subroutine V3_ort !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine V3_V3xxV3 ( V, V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Vector production - !------------------------------------------------------------------------------------------- real(c_double), dimension(0:2), intent(out) :: V real(c_double), dimension(0:2), intent(in) :: V1, V2 !------------------------------------------------------------------------------------------- @@ -175,10 +171,10 @@ contains !********************************************************************** end subroutine EulerAngles !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! File inout and output +! File input and output !--------------------------------------------------------------------------------------------------- - integer(c_int) function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! character*(*), intent(in) :: Name, Params, Path !------------------------------------------------------------------------------------------- integer(c_int) :: Fuid diff --git a/lib/mesont/TPMM0.f90 b/lib/mesont/TPMM0.f90 index 659855f049..0ec9ce6248 100644 --- a/lib/mesont/TPMM0.f90 +++ b/lib/mesont/TPMM0.f90 @@ -15,9 +15,9 @@ module TPMM0 !************************************************************************************** ! -! TMD Library: Combined/Weighted potential of type 0 +! Combined/Weighted TPM potential of type 0. ! -! Direct application of SST potential to calculation of segment-segment interaction +! Direct application of SST potential to calculation of segment-segment interaction. ! !--------------------------------------------------------------------------------------------------- ! @@ -27,7 +27,6 @@ module TPMM0 !****************************************************************** ! !*************************************************************************************************** -!use TMDCounters use TubePotMono use iso_c_binding, only : c_int, c_double, c_char implicit none @@ -38,13 +37,12 @@ contains !********************************************************************** real(c_double), intent(inout) :: Q, U real(c_double), dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2 real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 - integer(c_int), intent(in) :: EType + integer(c_int), intent(in) :: EType !------------------------------------------------------------------------------------------- real(c_double) :: Qa, Ua, Fd, L2 real(c_double), dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a, R2_3, R2, Laxis2, F - integer(c_int) :: IntSign + integer(c_int) :: IntSign !------------------------------------------------------------------------------------------- -! C_TPM_4 = C_TPM_4 + 1 R2 = 0.5d+00 * ( R2_1 + R2_2 ) Laxis2 = R2_2 - R2_1 L2 = S_V3norm3 ( Laxis2 ) @@ -85,14 +83,14 @@ contains !********************************************************************** integer(c_int) function TPMInteractionFW0 ( QQ, U, U1, U2, UU, F1, F2, F, G1, G2, R1, R2, N, NMAX, R ) real(c_double), intent(inout) :: U, U1, U2 - integer(c_int), intent(in) :: N, NMAX + integer(c_int), intent(in) :: N, NMAX real(c_double), dimension(0:NMAX-1), intent(out) :: QQ, UU real(c_double), dimension(0:2), intent(out) :: F1, F2 real(c_double), dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2 real(c_double), dimension(0:2), intent(in) :: R1, R2 real(c_double), dimension(0:2,0:NMAX-1), intent(in) :: R !------------------------------------------------------------------------------------------- - integer(c_int) :: i, SType2, GeomID, EType + integer(c_int) :: i, SType2, GeomID, EType real(c_double) :: Ua real(c_double), dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a real(c_double), dimension(0:2) :: R1a, R2a, Laxis1, Laxis2, L12, DR @@ -174,8 +172,9 @@ contains !********************************************************************** EType = 2 end if - if ( TPMInteractionFSS ( QQ(i), Ua, F1_1a, F1_2a, F2_1a, F2_2a, R1, R2, R(0:2,i), R(0:2,i+1), EType ) > 0 ) then - TPMInteractionFW0 = 1 + if ( TPMInteractionFSS ( QQ(i), Ua, F1_1a, F1_2a, F2_1a, F2_2a, R1, R2, R(0:2,i), R(0:2,i+1), & + EType ) > 0 ) then + TPMInteractionFW0 = 1 U = U + Ua Ua = 0.25d+00 * Ua U1 = U1 + Ua diff --git a/lib/mesont/TPMM1.f90 b/lib/mesont/TPMM1.f90 index 98784ba593..d0fec22cf9 100644 --- a/lib/mesont/TPMM1.f90 +++ b/lib/mesont/TPMM1.f90 @@ -15,9 +15,8 @@ module TPMM1 !************************************************************************************** ! -! TMD Library: Combined/Weighted potential of type 3 +! Combined/Weighted potential of type 1. ! -! Weighting functions are the same as in potential of type 2. ! Calculation of the combined potential is based on the 'extended' chain. ! !--------------------------------------------------------------------------------------------------- @@ -28,7 +27,6 @@ module TPMM1 !****************************************************************** ! !*************************************************************************************************** -!use TMDCounters use TubePotMono use iso_c_binding, only : c_int, c_double, c_char implicit none @@ -37,8 +35,8 @@ implicit none ! Constants !--------------------------------------------------------------------------------------------------- - ! Maximal length of a segment chain - integer(c_int), parameter :: TPM_MAX_CHAIN = 100 + ! Maximum length of a segment chain + integer(c_int), parameter :: TPM_MAX_CHAIN = 100 !--------------------------------------------------------------------------------------------------- ! Numerical parameters @@ -104,7 +102,7 @@ contains !********************************************************************** E2_2 = dWdD * ( E - t * E20 ) end subroutine PairWeight1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function EndWeight1 ( W, E1_1, E1_2, E2_1, E2_2, R1_1, R1_2, R2_1, R2_2 ) !!!!!!!! + integer(c_int) function EndWeight1 ( W, E1_1, E1_2, E2_1, E2_2, R1_1, R1_2, R2_1, R2_2 ) !!! real(c_double), intent(out) :: W real(c_double), dimension(0:2), intent(out) :: E1_1, E1_2, E2_1, E2_2 real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 @@ -154,19 +152,17 @@ contains !********************************************************************** real(c_double), intent(out) :: Q, U real(c_double), dimension(0:2), intent(out) :: F1, F2, P1, P2, Pe, Pe1 real(c_double), dimension(0:2), intent(in) :: R1, R2, Q1, Q2, Qe, Qe1 - integer(c_int), intent(in) :: EType + integer(c_int), intent(in) :: EType !------------------------------------------------------------------------------------------- real(c_double), dimension(0:2) :: M, QX, Me, F1a, F2a, P1a, P2a, F1b, F2b, P1b, P2b, ER1, ER2, EQe, EQe1 real(c_double) :: W, W1, D, Qa, Qb, Ua, Ub, L, Pee, Peea, Peeb, DU - integer(c_int) :: IntSigna, IntSignb, CaseID + integer(c_int) :: IntSigna, IntSignb, CaseID !------------------------------------------------------------------------------------------- if ( EType == 0 ) then -! C_TPM_0 = C_TPM_0 + 1 TPMInteractionFC1 = TPMInteractionF ( Q, U, F1, F2, P1, P2, Pee, R1, R2, Q1, Q2, 0 ) Pe = 0.0d+00 Pe1 = 0.0d+00 else if ( EType < 3 ) then -! C_TPM_1 = C_TPM_1 + 1 QX = 0.5d+00 * ( Q1 + Q2 ) M = Q2 - Q1 L = S_V3norm3 ( M ) @@ -206,7 +202,6 @@ contains !********************************************************************** end if if ( CaseID == 0 ) then -! C_TPM_1 = C_TPM_1 + 1 TPMInteractionFC1 = IntSigna Q = Qa U = Ua @@ -218,7 +213,6 @@ contains !********************************************************************** P1 = P1a + QX P2 = P2a + QX else if ( CaseID == 2 ) then -! C_TPM_0 = C_TPM_0 + 1 TPMInteractionFC1 = IntSignb Q = Qb U = Ub @@ -229,7 +223,6 @@ contains !********************************************************************** Pe = 0.0d+00 Pe1 = 0.0d+00 else -! C_TPM_2 = C_TPM_2 + 1 TPMInteractionFC1 = 0 if ( IntSigna > 0 .or. IntSignb > 0 ) TPMInteractionFC1 = 1 W1 = 1.0d+00 - W @@ -248,16 +241,16 @@ contains !********************************************************************** end if end function TPMInteractionFC1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMInteractionFW1 ( QQ, U, U1, U2, UU, F1, F2, F, Fe, G1, G2, R1, R2, N, NMAX, R, Re, EType ) + integer(c_int) function TPMInteractionFW1 ( QQ, U, U1, U2, UU, F1, F2, F, Fe, G1, G2, R1, R2, N, NMAX, R, Re, EType ) real(c_double), intent(out) :: U, U1, U2 - integer(c_int), intent(in) :: N, NMAX, EType + integer(c_int), intent(in) :: N, NMAX, EType real(c_double), dimension(0:NMAX-1), intent(out) :: QQ, UU real(c_double), dimension(0:2), intent(out) :: F1, F2, Fe real(c_double), dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2 real(c_double), dimension(0:2), intent(in) :: R1, R2, Re real(c_double), dimension(0:2,0:NMAX-1), intent(in) :: R !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j + integer(c_int) :: i, j real(c_double) :: Q, WW, DD !------------------------------------------------------------------------------------------- Q1 = 0.0d+00 diff --git a/lib/mesont/TubePotBase.f90 b/lib/mesont/TubePotBase.f90 index 1863c36b91..6330d7ffb0 100644 --- a/lib/mesont/TubePotBase.f90 +++ b/lib/mesont/TubePotBase.f90 @@ -15,8 +15,7 @@ module TubePotBase !******************************************************************************** ! -! TMD Library: Non-Bonded pair interaction potential and transfer functions for atoms composing -! nanotubes. +! Non-bonded pair interaction potential and transfer functions for atoms composing nanotubes. ! !--------------------------------------------------------------------------------------------------- ! @@ -33,7 +32,7 @@ module TubePotBase !************************************************************ ! -- TPBU, Lennard-Jones (12-6) potential ! -- TPBQ, Transfer function ! -! All default values are adjusted for non-bonded carbob-carbon interaction in carbon nanotubes. +! All default values are adjusted for non-bonded carbon-carbon interaction in carbon nanotubes. ! !*************************************************************************************************** @@ -46,11 +45,11 @@ implicit none !--------------------------------------------------------------------------------------------------- ! Types of the potential with respect to the breathing mode - integer(c_int), parameter :: TP_POT_MONO_R = 0 - integer(c_int), parameter :: TP_POT_POLY_R = 1 + integer(c_int), parameter :: TP_POT_MONO_R = 0 + integer(c_int), parameter :: TP_POT_POLY_R = 1 ! Maximal number of elements in corresponding tables - integer(c_int), parameter :: TPBNMAX = 2001 + integer(c_int), parameter :: TPBNMAX = 2001 ! Numerical constants real(c_double), parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5 @@ -58,12 +57,12 @@ implicit none ! Mass of C atom real(c_double), parameter :: TPBMc = 12.0107d+00 ! (Da) - ! Parameters of the Van der Waals inteaction between carbon atoms in graphene sheets, see + ! Parameters of the Van der Waals interaction between carbon atoms in graphene sheets, see ! Stuart S.J., Tutein A.B., Harrison J.A., J. Chem. Phys. 112(14), 2000 real(c_double), parameter :: TPBEcc = 0.00284d+00 ! (eV) real(c_double), parameter :: TPBScc = 3.4d+00 ! (A) - ! Lattice parameter and numerical density of atoms for a graphene sheet, see + ! Lattice parameter and surface number density of atoms for a graphene sheet, see ! Dresselhaus et al, Carbon 33(7), 1995 real(c_double), parameter :: TPBAcc = 1.421d+00 ! (A) real(c_double), parameter :: TPBDcc = 4.0d+00 / ( TPBConstD * TPBAcc * TPBAcc ) ! (1/A^2) @@ -71,15 +70,13 @@ implicit none ! Specific heat of carbon nanotubes real(c_double), parameter :: TPBSHcc = 600.0d+00 / K_MDCU ! (eV/(Da*K)) - ! Cutoff distances for interactomic potential and transfer function + ! Cutoff distances for the interactomic potential and transfer function. ! Changes in these parameters can result in necessity to change some numerical parameters too. real(c_double), parameter :: TPBRmincc = 0.001d+00 * TPBScc ! (A) real(c_double), parameter :: TPBRcutoffcc = 3.0d+00 * TPBScc ! (A) real(c_double), parameter :: TPBRcutoff1cc = 2.16d+00 * TPBScc ! (A) ! Parameters of the transfer function for non-bonded interaction between carbon atoms - !real(c_double), parameter :: TPBQScc = TPBScc ! (A) - !real(c_double), parameter :: TPBQRcutoff1cc = 2.16d+00 * TPBScc ! (A) real(c_double), parameter :: TPBQScc = 7.0d+00 ! (A) real(c_double), parameter :: TPBQRcutoff1cc = 8.0d+00 ! (A) @@ -87,46 +84,46 @@ implicit none ! Global variables !--------------------------------------------------------------------------------------------------- - logical :: TPErrCheck = .true. ! Set to .true. to generate diagnostic and warning messages - character*512 :: TPErrMsg = '' ! Typically, this variable is set up in F_tt () + ! Set to .true. to generate diagnostic and warning messages + logical :: TPErrCheck = .true. + character*512 :: TPErrMsg = '' - real(c_double) :: TPGeomPrec = 1.0d-06 ! Geometric precision, see TPInt - integer(c_int) :: TPPotType = TP_POT_MONO_R ! Type of the potential with respect to the breathing mode + real(c_double) :: TPGeomPrec = 1.0d-06 ! Geometric precision, see TPInt + integer(c_int) :: TPPotType = TP_POT_MONO_R ! Type of the potential with respect to the breathing mode - ! Physical parameters of the interatomic potential and atoms distribution at the surface + ! Parameters of the interatomic potential and atoms distribution at the surface ! of the tube - real(c_double) :: TPBM = TPBMc ! Mass of an atom, Da - real(c_double) :: TPBE = TPBEcc ! Depth of the energy well in LJ (12-6) interatomic potential (eV) - real(c_double) :: TPBS = TPBScc ! Sigma parameter of LJ (12-6) interatomic potential (A) - real(c_double) :: TPBD = TPBDcc ! Numerical density of atoms at the tube surface (1/A^2) - real(c_double) :: TPBSH = TPBSHcc ! Specific heat (eV/(Da*K)) + real(c_double) :: TPBM = TPBMc ! Mass of an atom (Da) + real(c_double) :: TPBE = TPBEcc ! Depth of the energy well in (12-6) LJ interatomic potential (eV) + real(c_double) :: TPBS = TPBScc ! Sigma parameter of (12-6) LJ interatomic potential (A) + real(c_double) :: TPBD = TPBDcc ! Numerical density of atoms at the tube surface (1/A^2) + real(c_double) :: TPBSH = TPBSHcc ! Specific heat (eV/(Da*K)) - real(c_double) :: TPBRmin = TPBRmincc ! (A) - real(c_double) :: TPBRcutoff = TPBRcutoffcc ! (A) - real(c_double) :: TPBRcutoff1 = TPBRcutoff1cc ! (A) + real(c_double) :: TPBRmin = TPBRmincc ! (A) + real(c_double) :: TPBRcutoff = TPBRcutoffcc ! (A) + real(c_double) :: TPBRcutoff1 = TPBRcutoff1cc ! (A) - ! Physical parameters of the transfer function + ! Parameters of the transfer function - real(c_double) :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A) - real(c_double) :: TPBQRcutoff1 = TPBQRcutoff1cc ! (A) + real(c_double) :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A) + real(c_double) :: TPBQRcutoff1 = TPBQRcutoff1cc! (A) - ! Auxilary variables + ! Auxiliary variables - real(c_double) :: TPBE4, TPBE24, TPBDRcutoff, TPBQDRcutoff - real(c_double) :: TPBQR0 ! Constant-value distance for the transfer function (A) + real(c_double) :: TPBE4, TPBE24, TPBDRcutoff, TPBQDRcutoff + real(c_double) :: TPBQR0 ! Constant-value distance for the transfer function (A) ! Table of inter-particle potential, force, and transfer function - integer(c_int) :: TPBN = TPBNMAX + integer(c_int) :: TPBN = TPBNMAX real(c_double) :: TPBDR real(c_double), dimension(0:TPBNMAX-1) :: TPBQ real(c_double), dimension(0:TPBNMAX-1) :: TPBU, TPBdUdR contains !****************************************************************************************** - integer(c_int) function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !TPBsizeof = sizeof ( TPBU ) + sizeof ( TPBdUdR ) + integer(c_int) function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! TPBsizeof = 8 * ( size ( TPBQ ) + size ( TPBU ) + size ( TPBdUdR ) ) end function TPBsizeof !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -134,11 +131,11 @@ contains !********************************************************************** ! Interpolation !--------------------------------------------------------------------------------------------------- - real(c_double) function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: R !------------------------------------------------------------------------------------------- real(c_double) :: Z, RR - integer(c_int) :: i + integer(c_int) :: i !------------------------------------------------------------------------------------------- if ( R < TPBRmin ) then !call PrintStdLogMsg ( TPErrMsg ) @@ -155,11 +152,11 @@ contains !********************************************************************** TPBQInt0 = TPBQ(i) * Z + TPBQ(i+1) * RR end function TPBQInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: R !------------------------------------------------------------------------------------------- real(c_double) :: Z, RR - integer(c_int) :: i + integer(c_int) :: i !------------------------------------------------------------------------------------------- if ( R < TPBRmin ) then !call PrintStdLogMsg ( TPErrMsg ) @@ -181,7 +178,7 @@ contains !********************************************************************** real(c_double), intent(in) :: R !------------------------------------------------------------------------------------------- real(c_double) :: Z, RR - integer(c_int) :: i + integer(c_int) :: i !------------------------------------------------------------------------------------------- if ( R < TPBRmin ) then !call PrintStdLogMsg ( TPErrMsg ) @@ -204,7 +201,7 @@ contains !********************************************************************** ! Calculation !--------------------------------------------------------------------------------------------------- - real(c_double) function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: R !------------------------------------------------------------------------------------------- real(c_double) :: Z, t, S @@ -226,7 +223,7 @@ contains !********************************************************************** endif end function TPBQCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: R !------------------------------------------------------------------------------------------- real(c_double) :: Z, t, S @@ -284,29 +281,6 @@ contains !********************************************************************** F2 = FF + FFF end subroutine TPBSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!--------------------------------------------------------------------------------------------------- -! Printing -!--------------------------------------------------------------------------------------------------- - -! subroutine TPBPrint ( FileName ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! character(c_char)*(*), intent(in) :: FileName -! !------------------------------------------------------------------------------------------- -! integer(c_int) :: Fuid -! integer(c_int) :: i -! real(c_double) :: R -! !------------------------------------------------------------------------------------------- -! Fuid = OpenFile ( FileName, "wt", outputpath ) -! write ( Fuid, '(a)' ) 'TITLE="TPB Potentials"' -! write ( Fuid, '(a)' ) 'VARIABLES="R" "Q" "U" "dUdR"' -! write ( Fuid, '(a)' ) 'ZONE' -! R = TPBRmin -! do i = 0, TPBN - 1 -! write ( Fuid, '(4e22.12)' ) R, TPBQ(i), TPBU(i), TPBDUDR(i) -! R = R + TPBDR -! end do -! call CloseFile ( Fuid ) -! end subroutine TPBPrint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !--------------------------------------------------------------------------------------------------- ! Initialization !--------------------------------------------------------------------------------------------------- diff --git a/lib/mesont/TubePotMono.f90 b/lib/mesont/TubePotMono.f90 index 587b1568df..b6ff0f6d15 100644 --- a/lib/mesont/TubePotMono.f90 +++ b/lib/mesont/TubePotMono.f90 @@ -15,35 +15,35 @@ module TubePotMono !******************************************************************************** ! -! TMD Library: Approximate tubular potentials and transfer functions for mono-radius tubes +! Approximate tubular potentials and transfer functions for mono-radius tubes. ! !--------------------------------------------------------------------------------------------------- ! ! Intel Fortran ! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00 +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020 ! !--------------------------------------------------------------------------------------------------- ! ! Four potentials and transfer functions are calculated in this module: ! -! 1. SSTP (segment - semi-infinite tube parallel). It gives a linear density of the potential along -! the segment axis which produced by a parallel semi-infinite tube. 2D tables for this potential -! are generated at initialization or can be loaded from a file +! 1. SSTP (segment - semi-infinite tube parallel): Linear density of the potential along +! the segment axis which is produced by a parallel semi-infinite tube. 2D tables for this potential +! are generated at initialization or can be loaded from a file. ! -! 2. STP (segment - tube parallel). It gives a linear density of the potential along the segment axis -! which produced by a parallel infinite tubes. This is only a particular case of the SSTP potential, -! but it is considered separately for computational effiency. 1D tables of this potential are taken +! 2. STP (segment - tube parallel): Linear density of the potential along the segment axis +! which is produced by a parallel infinite tubes. This is only a particular case of the SSTP potential, +! but it is considered separately for computational efficiency. 1D tables of this potential are taken ! from 2D tables of SSTP potential. ! -! 3. SST (segment - semi-infinite tube). It gives a potential for a segment produced by a arbitrary- -! oriented semi-infinite tube. Data of this potential can not be kept in 2D tabels, therefore all +! 3. SST (segment - semi-infinite tube): Potential for a segment produced by an arbitrary- +! oriented semi-infinite tube. This potential can not be kept in 2D tables, therefore, all ! data are calculated 'on fly' with the help of SSTP potential and numerical integration along the ! segment axis ! -! 4. ST (segment - tube). It gives a potential for a segment produced by a arbitrary-oriented +! 4. ST (segment - tube): Potential for a segment produced by an arbitrary-oriented ! infinitely long tube. 2D tables for this potential are generated at initialization or can be -! loaded from a file +! loaded from a file. ! !*************************************************************************************************** @@ -72,8 +72,8 @@ implicit none !--------------------------------------------------------------------------------------------------- integer(c_int) :: TPMStartMode = 1 - character*512 :: TPMSSTPFile = 'TPMSSTP.xrs' - character*512 :: TPMAFile = 'TPMA.xrs' + character*512 :: TPMFile = 'MESONT-TABTP.xrs' + integer(c_int) :: TPMUnitID ! Unit for the tabulated potential file integer(c_int) :: TPMNZ = TPMNZMAX integer(c_int) :: TPMNZ1 = TPMNZMAX - 1 @@ -85,66 +85,68 @@ implicit none integer(c_int) :: TPMNX = TPMNXMAX integer(c_int) :: TPMNX1 = TPMNXMAX - 1 - integer :: TPMChiIndM ! Chirality index M - integer :: TPMChiIndN ! Chirality index N - real(c_double) :: TPMR1 - real(c_double) :: TPMR2 + integer :: TPMChiIndM ! Chirality index M + integer :: TPMChiIndN ! Chirality index N + real(c_double) :: TPMR1 + real(c_double) :: TPMR2 - real(c_double) :: TPMHmax - real(c_double) :: TPMDH + real(c_double) :: TPMHmax + real(c_double) :: TPMDH ! Parameters of empirical correction functions integer(c_int) :: TPMAN = 20 - real(c_double) :: TPMAHmin - real(c_double) :: TPMAHmax - real(c_double) :: TPMADH - real(c_double), dimension(0:TPMNHMAX-1) :: TPMAH, TPMAF, TPMAFxx + real(c_double) :: TPMAHmin + real(c_double) :: TPMAHmax + real(c_double) :: TPMADH + real(c_double), dimension(0:TPMNHMAX-1) :: TPMAH, TPMAF, TPMAFxx ! Fitting parameters that depend on the SWCNT chirality - real(c_double) :: TPMCaA = 0.22d+00 ! 0.22 for (10,10) CNTs - real(c_double) :: TPMCeA = 0.35d+00 ! 0.35 for (10,10) CNTs - real(c_double) :: TPMAHmin0 = 10.0d+00 ! 10.0 A for (10,10) CNTs + real(c_double) :: TPMCaA = 0.22d+00 ! 0.22 for (10,10) CNTs + real(c_double) :: TPMCeA = 0.35d+00 ! 0.35 for (10,10) CNTs + real(c_double) :: TPMAHmin0 = 10.0d+00 ! 10.0 A for (10,10) CNTs ! Parameters of SSTP integrator - real(c_double) :: TPMDE - real(c_double), dimension(0:TPMNEMAX-1) :: TPMCE, TPMSE + real(c_double) :: TPMDE + real(c_double), dimension(0:TPMNEMAX-1) :: TPMCE, TPMSE ! Additional parameters for SSTP potential - real(c_double) :: TPMSSTPDelta = 0.25d+00 + real(c_double) :: TPMSSTPDelta = 0.25d+00 integer(c_int) :: TPMSSTPNH integer(c_int) :: TPMSSTPNX - real(c_double) :: TPMSSTPX1 - real(c_double) :: TPMSSTPXmax - real(c_double) :: TPMSSTPDX + real(c_double) :: TPMSSTPX1 + real(c_double) :: TPMSSTPXmax + real(c_double) :: TPMSSTPDX real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSSTPG real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy - real(c_double), dimension(0:TPMNHMAX-1) :: TPMSSTPH - real(c_double), dimension(0:TPMNXMAX-1) :: TPMSSTPX + real(c_double), dimension(0:TPMNHMAX-1) :: TPMSSTPH + real(c_double), dimension(0:TPMNXMAX-1) :: TPMSSTPX ! Additional parameters for STP potential - ! In calcuation of this potential also some parameters of SSTP potential are used + ! In calculations of this potential, some parameters of SSTP potential are also used. ! In particular, STP potential has no its own integrator. All data comes from SSTP integrator. ! It does not result in any computational inefficiency unless the STP potential is used without SSTP one. integer(c_int) :: TPMNN = 10 - real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPG - real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPF, TPMSTPFxx + real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPG + real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPF, TPMSTPFxx ! Parameters for ST potential - real(c_double) :: TPMSTDelta = 1.0d+00 ! Minimal gap dh for ST-potential - integer(c_int) :: TPMSTNXS = 10 ! Number of subdivisions for every grid step in ST-integrator - real(c_double) :: TPMSTXmax - real(c_double) :: TPMSTH1 - real(c_double) :: TPMSTH2 - real(c_double) :: TPMSTDH12 + ! Minimum gap dh for ST-potential + real(c_double) :: TPMSTDelta = 1.0d+00 + ! Number of subdivisions for every grid step in ST-integrator + integer(c_int) :: TPMSTNXS = 10 + real(c_double) :: TPMSTXmax + real(c_double) :: TPMSTH1 + real(c_double) :: TPMSTH2 + real(c_double) :: TPMSTDH12 real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSTG real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy @@ -155,21 +157,22 @@ implicit none ! Height switch (at H=0 in SST-potential) integer(c_int) :: TPMHSwitch = 0 ! 1, use h-switch; 0, do not use the switch - real(c_double) :: TPMHS = 3.0d+00 ! Switch height, Angstrom + real(c_double) :: TPMHS = 3.0d+00 ! Switch height, Angstrom ! Angle switch integer(c_int) :: TPMASwitch = 0 ! 1, use a-switch; 0, do not use the switch - real(c_double) :: TPMAS = 3.0d+00 ! Switch angle, degree - real(c_double) :: TPMASMin - real(c_double) :: TPMASMax - real(c_double) :: TPMASDelta + real(c_double) :: TPMAS = 3.0d+00 ! Switch angle, degree + real(c_double) :: TPMASMin + real(c_double) :: TPMASMax + real(c_double) :: TPMASDelta ! These variables are used to print error message if intertube force filed fails - integer(c_int) :: Err_CNT1 = 0, Err_CNT1_Node = 0, Err_CNT2 = 0, Err_CNT2_Node1 = 0, Err_CNT2_Node2 = 0, Err_EType = 0 + integer(c_int) :: Err_CNT1 = 0, Err_CNT1_Node = 0, Err_CNT2 = 0, & + Err_CNT2_Node1 = 0, Err_CNT2_Node2 = 0, Err_EType = 0 contains !****************************************************************************************** - integer(c_int) function TPMsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! TPMsizeof = 8 * ( size ( TPMAH ) + size ( TPMAF ) + size ( TPMAFxx ) & + size ( TPMCE ) + size ( TPMSE ) + size ( TPMSSTPG ) + size ( TPMSSTPF ) & + size ( TPMSSTPFxx ) + size ( TPMSSTPFyy ) + size ( TPMSSTPFxxyy ) & @@ -183,22 +186,23 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- subroutine PrintTPErrMsg () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !write ( TPErrMsg, fmt = '(a,i8,a,i8,a,i8,a,i8,a,i8,a,i1)' ) 'CNT ', Err_CNT1, ' [', Err_CNT1_Node,'] with CNT ', Err_CNT2, ' [', Err_CNT2_Node1, ', ', Err_CNT2_Node2, '] E=', Err_EType + !write ( TPErrMsg, fmt = '(a,i8,a,i8,a,i8,a,i8,a,i8,a,i1)' ) 'CNT ', Err_CNT1, ' [', & + ! Err_CNT1_Node,'] with CNT ', Err_CNT2, ' [', Err_CNT2_Node1, ', ', Err_CNT2_Node2, '] E=', Err_EType !call PrintStdLogMsg ( TPErrMsg ) end subroutine PrintTPErrMsg !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! SSTP: Linear potential density for the tube interacting with parallel semi-infinte tube +! SSTP: Linear potential density for the tube interacting with parallel semi-infinite tube !--------------------------------------------------------------------------------------------------- subroutine TPMSSTPIntegrator ( Q, U, H, D ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function calculates the transfer function Q and potential U between an infinitely long - ! tube and a cross-section of another parallel tube for given height H and displacemnet D. + ! tube and a cross-section of another parallel tube for given height H and displacement D. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), intent(in) :: H, D !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j, k + integer(c_int) :: i, j, k real(c_double) :: C, Zmin, Zmax, DZ, R1X, R1Y, R2X, R2Y, R2Z, R, Rcutoff2 !------------------------------------------------------------------------------------------- Q = 0.0d+00 @@ -236,14 +240,14 @@ contains !********************************************************************** U = U * sqr ( TPBD ) * C end subroutine TPMSSTPIntegrator !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPInt0 ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMSSTPInt0 ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the transfer function Q and potential U for the SSTP potential - ! calculated with interpolation in the table without switch + ! calculated by interpolation in the table without switch. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j + integer(c_int) :: i, j real(c_double) :: XX !------------------------------------------------------------------------------------------- i = 1 + int ( H / TPMDH ) @@ -270,13 +274,13 @@ contains !********************************************************************** XX = X end if Q = CalcLinFun2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPG ) - U = CalcSpline2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy ) + U = CalcSpline2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy ) TPMSSTPInt0 = 1 end function TPMSSTPInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPInt0S ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMSSTPInt0S ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the transfer function Q and potential U for the SSTP potential - ! calculated with interpolation in the table and switch to the case of zero H + ! calculated by interpolation in the table and switch to the case of zero H. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), intent(in) :: H, X @@ -300,14 +304,14 @@ contains !********************************************************************** end if end function TPMSSTPInt0S !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPInt1 ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function returns the transfer function Q, potential U, and derivarives Uh=dU/dH and - ! Ux=dU/dX for the SSTP potential calculated with interpolation in the table without switch + integer(c_int) function TPMSSTPInt1 ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This function returns the transfer function Q, potential U, and derivatives Uh=dU/dH and + ! Ux=dU/dX for the SSTP potential calculated by interpolation in the table without switch !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U, Uh, Ux real(c_double), intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j + integer(c_int) :: i, j real(c_double) :: XX !------------------------------------------------------------------------------------------- i = 1 + int ( H / TPMDH ) @@ -336,19 +340,20 @@ contains !********************************************************************** XX = X end if Q = CalcLinFun2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPG ) - call CalcSpline2_1 ( U, Uh, Ux, i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy ) + call CalcSpline2_1 ( U, Uh, Ux, i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, & + TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy ) TPMSSTPInt1 = 1 end function TPMSSTPInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPInt1S ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function returns the transfer function Q, potential U, and derivarives Uh=dU/dH and - ! Ux=dU/dX for the SSTP potential calculated with interpolation in the table and switch to + integer(c_int) function TPMSSTPInt1S ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This function returns the transfer function Q, potential U, and derivatives Uh=dU/dH and + ! Ux=dU/dX for the SSTP potential calculated by interpolation in the table and switch to ! the case of zero H. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U, Uh, Ux real(c_double), intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: IntSign + integer(c_int) :: IntSign real(c_double) :: t, W, W1, dWdH, Qa, Ua, Uha, Uxa !------------------------------------------------------------------------------------------- if ( TPMHSwitch == 0 ) then @@ -372,28 +377,26 @@ contains !********************************************************************** end function TPMSSTPInt1S !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSSTPWrite () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function writes the table of the SSTP potential to the disk file + ! This function writes the table of the SSTP potential to a disk file. !------------------------------------------------------------------------------------------- - integer(c_int) :: Fuid, i, j + integer(c_int) :: i, j !------------------------------------------------------------------------------------------- - Fuid = OpenFile ( TPMSSTPFile, 'wt', '' ) - write ( unit = Fuid, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMNH1, TPMNX1 + write ( unit = TPMUnitID, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMNH1, TPMNX1 do i = 0, TPMNH1 do j = 0, TPMNX1 - if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) write ( unit = Fuid, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j) + if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) & + write ( unit = TPMUnitID, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j) end do end do - call CloseFile ( Fuid ) end subroutine TPMSSTPWrite !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSSTPRead () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function reads the table of the SSTP potential from the disk file + ! This function reads the table of the SSTP potential from a disk file. !------------------------------------------------------------------------------------------- - integer(c_int) :: Fuid, i, j + integer(c_int) :: i, j integer(c_int) :: iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1 !------------------------------------------------------------------------------------------- - Fuid = OpenFile ( TPMSSTPFile, 'rt', '' ) - read ( unit = Fuid, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1 + read ( unit = TPMUnitID, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1 if ( iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN ) then print *, 'ERROR in [TPMSSTPRead]: iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN' stop @@ -404,18 +407,18 @@ contains !********************************************************************** end if do i = 0, TPMNH1 do j = 0, TPMNX1 - if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) read ( unit = Fuid, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j) + if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) & + read ( unit = TPMUnitID, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j) end do end do - call CloseFile ( Fuid ) end subroutine TPMSSTPRead !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSSTPInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function calculates the table of the SSTP potential + ! This function calculates the table of the SSTP potential. !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j + integer(c_int) :: i, j real(c_double) :: E - character(c_char) :: Msg + character(c_char) :: Msg real(c_double), dimension(0:TPMNMAX-1) :: FF, DD, MM, K0, K1, K2 !------------------------------------------------------------------------------------------- TPMDE = M_2PI / TPMNE @@ -441,7 +444,8 @@ contains !********************************************************************** do j = 0, TPMNX1 if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) then call TPMSSTPIntegrator ( TPMSSTPG(i,j), TPMSSTPF(i,j), TPMSSTPH(i), TPMSSTPX(j) ) - print '(2i5,a,e20.10,a,e20.10,a,e20.10,a,e20.10)', i, j, ' H=', TPMSSTPH(i), ', X=', TPMSSTPX(j), ', Q=', TPMSSTPG(i,j), ', U=', TPMSSTPF(i,j) + print '(2i5,a,e20.10,a,e20.10,a,e20.10,a,e20.10)', i, j, ' H=', TPMSSTPH(i), & + ', X=', TPMSSTPX(j), ', Q=', TPMSSTPG(i,j), ', U=', TPMSSTPF(i,j) end if end do end do @@ -449,22 +453,23 @@ contains !********************************************************************** else call TPMSSTPRead () end if - call CreateSpline2Ext ( 3, 3, 3, 3, TPMNH, TPMSSTPNH, TPMNX, TPMSSTPNX, TPMNMAX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy, FF, MM, DD, K0, K1, K2 ) + call CreateSpline2Ext ( 3, 3, 3, 3, TPMNH, TPMSSTPNH, TPMNX, TPMSSTPNX, TPMNMAX, TPMSSTPH, TPMSSTPX, & + TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy, FF, MM, DD, K0, K1, K2 ) end subroutine TPMSSTPInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! STP Potential for an infinite tube interacting with a parallel segment. No actual initialization -! is necessary for this potential, since the data are taken from the table for SSTP potenrials. +! STP potential for an infinite tube interacting with a parallel segment. No actual initialization +! is necessary for this potential, since the data are taken from the table for the SSTP potential. !--------------------------------------------------------------------------------------------------- - integer(c_int) function TPMSTPInt0 ( Q, U, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMSTPInt0 ( Q, U, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the transfer function Q and potential U for the STP potential - ! calculated with interpolation in the table + ! calculated by interpolation in the table. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), intent(in) :: H !------------------------------------------------------------------------------------------- - integer(c_int) :: i + integer(c_int) :: i !------------------------------------------------------------------------------------------- i = 1 + int ( H / TPMDH ) if ( i < TPMSSTPNH ) then @@ -485,13 +490,13 @@ contains !********************************************************************** TPMSTPInt0 = 1 end function TPMSTPInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTPInt1 ( Q, U, dUdH, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMSTPInt1 ( Q, U, dUdH, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the transfer function Q, potential U, and derivative dUdH for - ! the STP potential calculated with interpolation in the table + ! the STP potential calculated by interpolation in the table. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U, dUdH real(c_double), intent(in) :: H - integer(c_int) :: i + integer(c_int) :: i !------------------------------------------------------------------------------------------- i = 1 + int ( H / TPMDH ) if ( i < TPMSSTPNH ) then @@ -521,8 +526,8 @@ contains !********************************************************************** end subroutine TPMSTPInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! Fitting functions for SST and ST potential. -! This correction functions are choosen empirically to improve accuracy of SST and ST potentials. +! Fitting functions for the SST and ST potentials. +! This correction functions are chosen empirically to improve accuracy of the SST and ST potentials. !--------------------------------------------------------------------------------------------------- subroutine TPMAInit ( X1_1, X1_2, X2_1, X2_2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -531,16 +536,15 @@ contains !********************************************************************** real(c_double), dimension(0:2) :: R1_1, R1_2, R2_1, R2_2 real(c_double), dimension(0:2) :: Fa, Ma real(c_double) :: Qa, Ua, Qb, Ub, X, H, HH, Ucoeff, Uamin, Ubmin - integer(c_int) :: i, j, IntSign, Fuid + integer(c_int) :: i, j, IntSign real(c_double), dimension(0:TPMNHMAX-1) :: D, K0, K1, K2 - integer(c_int) :: iTPMChiIndM, iTPMChiIndN, iTPMAN + integer(c_int) :: iTPMChiIndM, iTPMChiIndN, iTPMAN !------------------------------------------------------------------------------------------- TPMAHmin = TPMR1 + TPMR2 + TPMSTDelta TPMAHmax = TPMR1 + TPMR2 + 0.95d+00 * TPBRcutoff TPMADH = ( TPMAHmax - TPMAHmin ) / ( TPMAN - 1 ) if ( TPMStartMode == 1 ) then - Fuid = OpenFile ( TPMAFile, 'rt', '' ) - read ( unit = Fuid, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMAN + read ( unit = TPMUnitID, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMAN if ( iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN ) then print *, 'ERROR in [TPMAInit]: iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN' stop @@ -551,9 +555,8 @@ contains !********************************************************************** end if do i = 0, TPMAN - 1 TPMAH(i) = TPMAHmin + i * TPMADH - read ( unit = Fuid, fmt = * ) TPMAF(i) + read ( unit = TPMUnitID, fmt = * ) TPMAF(i) end do - call CloseFile ( Fuid ) call CreateSpline1 ( 3, 3, TPMAN, TPMAH, TPMAF, TPMAFxx, D, K0, K1, K2 ) return end if @@ -583,19 +586,17 @@ contains !********************************************************************** end do TPMAF(i) = Uamin / Ubmin end do - Fuid = OpenFile ( TPMAFile, 'wt', '' ) - write ( unit = Fuid, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMAN + write ( unit = TPMUnitID, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMAN do i = 0, TPMAN - 1 - write ( unit = Fuid, fmt = * ) TPMAF(i) + write ( unit = TPMUnitID, fmt = * ) TPMAF(i) end do - call CloseFile ( Fuid ) call CreateSpline1 ( 3, 3, TPMAN, TPMAH, TPMAF, TPMAFxx, D, K0, K1, K2 ) end subroutine TPMAInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMA0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPMA0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: H !------------------------------------------------------------------------------------------- - integer(c_int) :: i + integer(c_int) :: i real(c_double) :: A0, t, S !------------------------------------------------------------------------------------------- if ( H > TPMAHmax ) then @@ -620,7 +621,7 @@ contains !********************************************************************** real(c_double), intent(out) :: A, Ah real(c_double), intent(in) :: H !------------------------------------------------------------------------------------------- - integer(c_int) :: i + integer(c_int) :: i real(c_double) :: A0, t, S, dSdH !------------------------------------------------------------------------------------------- if ( H > TPMAHmax ) then @@ -646,7 +647,7 @@ contains !********************************************************************** call CalcSpline1_1 ( A, Ah, i, H, TPMAN, TPMAH, TPMAF, TPMAFxx ) end subroutine TPMA1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMCu0 ( H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPMCu0 ( H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the correction function for the magnitude of the potential. !------------------------------------------------------------------------------------------- real(c_double), intent(in) :: H, cosA, sinA @@ -655,8 +656,8 @@ contains !********************************************************************** end function TPMCu0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMCu1 ( Cu, CuH, CuA, H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Thi subroutine calculates the correction function Cu for magnitude of the potential and - ! its derivatives CuH, CuA. + ! The subroutine calculates the correction function Cu for the magnitude of the potential and + ! its derivatives CuH and CuA. !------------------------------------------------------------------------------------------- real(c_double), intent(ouT) :: Cu, CuH, CuA real(c_double), intent(in) :: H, cosA, sinA @@ -670,7 +671,7 @@ contains !********************************************************************** CuA = AA * 2.0d+0 * cosA * sinA end subroutine TPMCu1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMCa0 ( cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPMCa0 ( cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the correction function for the argument of the potential. ! If correction is not necessary, it should return sinA. !------------------------------------------------------------------------------------------- @@ -679,9 +680,9 @@ contains !********************************************************************** TPMCa0 = sinA / ( 1.0d+00 - TPMCaA * sqr ( sinA ) ) end function TPMCa0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine TPMCa1 ( Ca, CaA, Ka, KaA, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine TPMCa1 ( Ca, CaA, Ka, KaA, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine calculates the correction function Cu for the depth of the potential well - ! and its derivatives CuH, CuA. If correction is not necessary, it should return Ca = sinA + ! and its derivatives CuH and CuA. If correction is not necessary, it returns Ca = sinA ! and CaA = cosA. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Ca, CaA, Ka, KaA @@ -693,9 +694,9 @@ contains !********************************************************************** CaA = cosA * Ka + sinA * KaA end subroutine TPMCa1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMCe0 ( sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPMCe0 ( sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the correction function for the argument of the potential. - ! If correction is not necessary, it should return sinA. + ! If correction is not necessary, it returns sinA. !------------------------------------------------------------------------------------------- real(c_double), intent(in) :: sinA !------------------------------------------------------------------------------------------- @@ -703,7 +704,7 @@ contains !********************************************************************** end function TPMCe0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMCe1 ( Ce, CeA, Ke, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! If correction is not necessary, it should return Ce = 1 and CeA = 0. + ! If correction is not necessary, it returns Ce = 1 and CeA = 0. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Ce, CeA, Ke real(c_double), intent(in) :: cosA, sinA @@ -714,24 +715,24 @@ contains !********************************************************************** end subroutine TPMCe1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! SST Potential for the semi-infinite tube interacting with segment. -! This potential does not need any initialization. All necessry data is taken from tables of the +! SST potential for the semi-infinite tube interacting with segment. +! This potential does not need any initialization. All necessary data is taken from tables of the ! SSTP potential. !--------------------------------------------------------------------------------------------------- - integer(c_int) function TPMSSTPotential ( Q, U, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!!!!!!!!!!! - ! This function calculates the transfer function Q and potenial U applyed to a segment - ! from asemi-infinte tube based on numerical integration (trapesond rule) along the segment + integer(c_int) function TPMSSTPotential ( Q, U, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!!!!!! + ! This function calculates the transfer function Q and potential U applied to a segment + ! from a semi-infinite tube based on the numerical integration (trapezoidal rule) along the segment ! axis for non-parallel objects. - ! Relative position of the nanotube and segment are given by axial positions of the segment - ! ends X1 and X2, height H, cosA= cos(A), where A is the cross-axis angle, and displacement - ! D of the nanotube end. + ! Relative position of the nanotube and segment is given by axial positions of the segment + ! ends X1 and X2, height H, cosA= cos(A), where A is the cross-axis angle, and the displacement + ! D of a nanotube end. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), intent(in) :: X1, X2, H, cosA, D - integer(c_int), intent(in) :: N ! Number of nodes for numerical integration + integer(c_int), intent(in) :: N ! Number of nodes for numerical integration real(c_double) :: sinA, Qs, Us, DX, X, XX, HH, Cu, Ca, Ce - integer(c_int) :: i + integer(c_int) :: i !------------------------------------------------------------------------------------------- Q = 0.0d+00 U = 0.0d+00 @@ -759,18 +760,18 @@ contains !********************************************************************** U = Cu * U * DX end function TPMSSTPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPotentialPar ( Q, U, R1_1, Laxis1, R2_1, Laxis2, L1, N ) !!!!!!!!!! - ! Potential applyed to the segment from the semi-infinte tube is calculated by numerical - ! integration (trapesond rule) along the segment axis for parallel objects. + integer(c_int) function TPMSSTPotentialPar ( Q, U, R1_1, Laxis1, R2_1, Laxis2, L1, N ) !!!!! + ! Potential for a segment and a semi-infinite tube is calculated by the numerical + ! integration (trapezoidal rule) along the segment axis for parallel objects. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), dimension(0:2), intent(in) :: R1_1, Laxis1, R2_1, Laxis2 real(c_double), intent(in) :: L1 - integer(c_int), intent(in) :: N ! Number of nodes for numerical integration + integer(c_int), intent(in) :: N ! Number of nodes for numerical integration !------------------------------------------------------------------------------------------- real(c_double) :: Qs, Us, DX, X, S, H real(c_double), dimension(0:2) :: R1, L12 - integer(c_int) :: i + integer(c_int) :: i !------------------------------------------------------------------------------------------- DX = L1 / ( N - 1 ) X = 0.0d+00 @@ -799,21 +800,21 @@ contains !********************************************************************** U = U * DX end function TPMSSTPotentialPar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTForces ( Q, U, F1, F2, Fd, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!! - ! Potential and forces applyed to the segment from the semi-infinte tube are calculated - ! by numerical integration (trapesond rule) along the segment axis. + integer(c_int) function TPMSSTForces ( Q, U, F1, F2, Fd, X1, X2, H, cosA, D, N ) !!!!!!!!!!! + ! Potential and forces applied to the segment from a semi-infinite tube are calculated + ! by the numerical integration (trapezoidal rule) along the segment axis. ! Non-parallel case. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U, Fd real(c_double), dimension(0:2), intent(out) :: F1, F2 real(c_double), intent(in) :: X1, X2, H, cosA, D - integer(c_int), intent(in) :: N ! Number of nodes for numerical integration + integer(c_int), intent(in) :: N ! Number of nodes for numerical integration !------------------------------------------------------------------------------------------- real(c_double) :: DX, sinA real(c_double) :: Qs, Us, Ush, Usx, Fx, Fy, Fz real(c_double) :: C, C1, C2, I0, Ih, Ih1, Ih2, Ix, Ix1, X, XX, HH real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA, Ce, CeA, Ke, Uh, Ua - integer(c_int) :: IntSign, i + integer(c_int) :: IntSign, i !------------------------------------------------------------------------------------------- I0 = 0.0d+00 Ih = 0.0d+00 @@ -891,20 +892,20 @@ contains !********************************************************************** Fd = Ce * Ix end function TPMSSTForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTForcesPar ( Q, U, F1, F2, Fd, R1_1, Laxis1, R2_1, Laxis2, L1, N ) ! - ! Potential and forces applyed to the segment from the semi-infinte tube are calculated by - ! numerical integration (trapesond rule) along the segment axis. - ! Non-parallel case + integer(c_int) function TPMSSTForcesPar ( Q, U, F1, F2, Fd, R1_1, Laxis1, R2_1, Laxis2, L1, N ) + ! Potential and forces applied to the segment from a semi-infinite tube are calculated by + ! the numerical integration (trapezoidal rule) along the segment axis. + ! Parallel case !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U, Fd real(c_double), dimension(0:2), intent(out) :: F1, F2 real(c_double), dimension(0:2), intent(in) :: R1_1, Laxis1, R2_1, Laxis2 real(c_double), intent(in) :: L1 - integer(c_int), intent(in) :: N ! Number of nodes for numerical integration + integer(c_int), intent(in) :: N ! Number of nodes for numerical integration !------------------------------------------------------------------------------------------- real(c_double) :: Qs, Us, Ush, Usx, DX, X, S, H, Beta, Gamma real(c_double), dimension(0:2) :: R1, L12, Fs - integer(c_int) :: i, N1 + integer(c_int) :: i, N1 !------------------------------------------------------------------------------------------- Q = 0.0d+00 U = 0.0d+00 @@ -955,14 +956,14 @@ contains !********************************************************************** end function TPMSSTForcesPar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! ST: Potential for the infinite tube interacting with segment +! ST: Potential for a infinite tube interacting with a segment !-------------------------------------------------------------------------------------------------- ! ! These functions are used to smooth boundaries in (H,X) domain for ST potential ! - real(c_double) function TPMSTXMin0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPMSTXMin0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: H !------------------------------------------------------------------------------------------- real(c_double) :: X @@ -975,10 +976,11 @@ contains !********************************************************************** return end if X = ( H - TPMSTH1 ) / TPMSTDH12 - TPMSTXMin0 = sqrt ( TPMSTH2 * TPMSTH2 - H * H ) * ( 1.0d+00 - X * X * X * ( 3.0d+00 * X * ( 2.0d+00 * X - 5.0d+00 ) + 10.0d+00 ) ) + TPMSTXMin0 = sqrt ( TPMSTH2 * TPMSTH2 - H * H ) & + * ( 1.0d+00 - X * X * X * ( 3.0d+00 * X * ( 2.0d+00 * X - 5.0d+00 ) + 10.0d+00 ) ) end function TPMSTXMin0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMSTXMax0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real(c_double) function TPMSTXMax0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(in) :: H !------------------------------------------------------------------------------------------- TPMSTXMax0 = sqrt ( TPMSTXMax * TPMSTXMax - H * H ) @@ -1025,7 +1027,7 @@ contains !********************************************************************** real(c_double), intent(in) :: H, X, DX !------------------------------------------------------------------------------------------- real(c_double) :: FFx, HH, DDX - integer(c_int) :: IntSign + integer(c_int) :: IntSign !------------------------------------------------------------------------------------------- DDX = 0.5 * DX G = G + Q * DDX @@ -1041,11 +1043,11 @@ contains !********************************************************************** end if end subroutine TPMSTIntegrator !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTInt0 ( G, F, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMSTInt0 ( G, F, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(out) :: G, F real(c_double), intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j + integer(c_int) :: i, j real(c_double) :: S, XA, XXX, XXXX, XMin, XMax !------------------------------------------------------------------------------------------- if ( H > TPMHmax ) then @@ -1087,11 +1089,11 @@ contains !********************************************************************** TPMSTInt0 = 1 end function TPMSTInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTInt1 ( G, F, Fh, Fx, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMSTInt1 ( G, F, Fh, Fx, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double), intent(inout) :: G, F, Fh, Fx real(c_double), intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j + integer(c_int) :: i, j real(c_double) :: S, XA, DX, XXX, XXXX, XMin, XMax, dXMindH, dXMaxdH !------------------------------------------------------------------------------------------- if ( H > TPMHmax ) then @@ -1136,7 +1138,8 @@ contains !********************************************************************** j = 1 + int ( XXXX * TPMNX1 ) end if G = S * CalcLinFun2_0 ( i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTG ) - call CalcSpline2_1 ( F, Fh, Fx, i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy ) + call CalcSpline2_1 ( F, Fh, Fx, i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, & + TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy ) Fx = Fx / DX Fh = Fh - Fx * ( dXMaxdH * XXX + dXMindH * ( 1.0d+00 - XXX ) ) F = F * S @@ -1144,10 +1147,10 @@ contains !********************************************************************** TPMSTInt1 = 1 end function TPMSTInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTPotential ( Q, U, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMSTPotential ( Q, U, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!! real(c_double), intent(out) :: Q, U real(c_double), intent(in) :: X1, X2, H, cosA - integer(c_int), intent(in) :: CaseID + integer(c_int), intent(in) :: CaseID !------------------------------------------------------------------------------------------- real(c_double) :: sinA, GG1, GG2, FF1, FF2, Ca, Cu !------------------------------------------------------------------------------------------- @@ -1166,17 +1169,17 @@ contains !********************************************************************** U = Cu * ( FF2 - FF1 ) / Ca end function TPMSTPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTForces ( Q, U, F1, F2, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!! + integer(c_int) function TPMSTForces ( Q, U, F1, F2, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!! real(c_double), intent(out) :: Q, U real(c_double), dimension(0:2), intent(out) :: F1, F2 real(c_double), intent(in) :: X1, X2, H, cosA - integer(c_int), intent(in) :: CaseID + integer(c_int), intent(in) :: CaseID !------------------------------------------------------------------------------------------- real(c_double) :: DX, sinA real(c_double) :: GG1, GG2, FF1, FF2, Fh1, Fh2, Fx1, Fx2 real(c_double) :: B, C, D real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA - integer(c_int) :: IntSign1, IntSign2 + integer(c_int) :: IntSign1, IntSign2 !------------------------------------------------------------------------------------------- DX = X2 - X1 if ( CaseID == MD_LINES_PAR ) then @@ -1230,13 +1233,13 @@ contains !********************************************************************** integer(c_int) function TPMSTForceTorque( Qi, Ui, Fi, Ti, Q, U, F, T, Psi, PsiA, Cap, L, H, cosA, CaseID ) real(c_double), intent(out) :: Qi, Ui, Fi, Ti, Q, U, F, T, Psi, PsiA, Cap real(c_double), intent(in) :: L, H, cosA - integer(c_int), intent(in) :: CaseID + integer(c_int), intent(in) :: CaseID !------------------------------------------------------------------------------------------- real(c_double) :: L2, sinA real(c_double) :: GG, FF, Fh, Fx, GGi, FFi, Fhi, Fxi real(c_double) :: B, C, D real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA - integer(c_int) :: IntSign + integer(c_int) :: IntSign !------------------------------------------------------------------------------------------- if ( CaseID == MD_LINES_PAR ) then TPMSTForceTorque = TPMSTPInt1 ( Q, U, F, H ) @@ -1296,7 +1299,7 @@ contains !********************************************************************** subroutine TPMSTInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! real(c_double) :: X, Q, U, DX, DDX, XMin, XMax - integer(c_int) :: i, j, k + integer(c_int) :: i, j, k real(c_double), dimension(0:TPMNMAX-1) :: FF, DD, MM, K0, K1, K2 !------------------------------------------------------------------------------------------- TPMSTH1 = TPMR1 + TPMR2 @@ -1330,12 +1333,13 @@ contains !********************************************************************** if ( j < TPMNX1 ) DX = ( XMax - XMin ) * ( TPMSTX(j+1) - TPMSTX(j) ) / TPMSTNXS end do end do - call CreateSpline2 ( 3, 3, 3, 3, TPMNH, TPMNX, TPMNMAX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy, FF, MM, DD, K0, K1, K2 ) + call CreateSpline2 ( 3, 3, 3, 3, TPMNH, TPMNX, TPMNMAX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, & + TPMSTFyy, TPMSTFxxyy, FF, MM, DD, K0, K1, K2 ) end subroutine TPMSTInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- ! Interaction functions: They can be used for calculation of the potential and forces between a -! segment and infinte or semi-infinite nanotube. +! segment and an infinite or semi-infinite nanotube. !--------------------------------------------------------------------------------------------------- subroutine TPMSegmentForces ( F2_1, F2_2, F1_1, F1_2, R1_1, R1_2, R2, Laxis2, L2 ) !!!!!!!!! @@ -1346,11 +1350,11 @@ contains !********************************************************************** real(c_double), dimension(0:2) :: F, M, RR !------------------------------------------------------------------------------------------- RR = R1_1 - R2 - ! Taking into account periodic boundaries + ! Taking into account periodic boundary conditions call ApplyPeriodicBC ( RR ) call V3_V3xxV3 ( M, RR, F1_1 ) RR = R1_2 - R2 - ! Taking into account periodic boundaries + ! Taking into account periodic boundary conditions call ApplyPeriodicBC ( RR ) call V3_V3xxV3 ( F, RR, F1_2 ) M = - ( M + F ) @@ -1359,23 +1363,23 @@ contains !********************************************************************** end subroutine TPMSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! - ! Interaction of a segment with semi-infinite or infinite tube + ! Interaction of a segment with a semi-infinite or infinite tube ! integer(c_int) function TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, SType2 ) ! SType2 in the type of the second segment: - ! SType2 == 0, internal segment - ! Stype2 == 1, point R2_1 is the end of the tube - ! Stype2 == 2, point R2_2 in the end of the tube + ! SType2 == 0, internal segment; + ! Stype2 == 1, point R2_1 is the end of the tube; + ! Stype2 == 2, point R2_2 in the end of the tube. !------------------------------------------------------------------------------------------- real(c_double), intent(inout) :: Q, U, Fd real(c_double), dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2 real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 !------------------------------------------------------------------------------------------- - integer(c_int) :: SType2 - real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, Ly, DR, F1_1a, F1_2a, F1_1b, F1_2b - real(c_double) :: H, cosA, D1, D2, L1, L2, cosA2, t, W, W1, dWdt, Qa, Ua, Qb, Ub, Fda, Fdb, FF - integer(c_int) :: GeomID, SwitchID, S, IntSigna, IntSignb + integer(c_int) :: SType2 + real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, Ly, DR, F1_1a, F1_2a, F1_1b, F1_2b + real(c_double) :: H, cosA, D1, D2, L1, L2, cosA2, t, W, W1, dWdt, Qa, Ua, Qb, Ub, Fda, Fdb, FF + integer(c_int) :: GeomID, SwitchID, S, IntSigna, IntSignb !------------------------------------------------------------------------------------------- R1 = 0.5d+00 * ( R1_1 + R1_2 ) R2 = 0.5d+00 * ( R2_1 + R2_2 ) @@ -1454,9 +1458,11 @@ contains !********************************************************************** F1_2b = 0.0d+00 end if else if ( Stype2 == 1 ) then - IntSignb = TPMSSTForcesPar ( Qb, Ub, F1_1b, F1_2b, Fdb, R1_1, Laxis1, R2_1, Laxis2, 2.0d+00 * L1, TPMNN ) + IntSignb = TPMSSTForcesPar ( Qb, Ub, F1_1b, F1_2b, Fdb, R1_1, Laxis1, R2_1, Laxis2, & + 2.0d+00 * L1, TPMNN ) else - IntSignb = TPMSSTForcesPar ( Qb, Ub, F1_1b, F1_2b, Fdb, R1_1, Laxis1, R2_2, Laxis2, 2.0d+00 * L1, TPMNN ) + IntSignb = TPMSSTForcesPar ( Qb, Ub, F1_1b, F1_2b, Fdb, R1_1, Laxis1, R2_2, Laxis2, & + 2.0d+00 * L1, TPMNN ) end if end if @@ -1486,11 +1492,11 @@ contains !********************************************************************** if ( IntSigna > 0 .or. IntSignb > 0 ) TPMInteractionF = 1 end if - ! Calculation of forces for the comlimentary tube + ! Calculation of forces for the complimentary tube if ( SType2 == 2 ) Laxis2 = - Laxis2 call TPMSegmentForces ( F2_1, F2_2, F1_1, F1_2, R1_1, R1_2, R2, Laxis2, 2.0d+00 * L2 ) - ! After the previous subroutine F2_1*Laxis2 = F2_2*Laxis2, but this is not true for the semi-infinite tube. - ! The force along the tube sould be applied to the end of the tube, while for the + ! After the previous subroutine call, F2_1*Laxis2 = F2_2*Laxis2, but this is not true for a semi-infinite tube. + ! The force along the tube should be applied to the end of the tube, while for the ! another point corresponding force is equal to zero. if ( SType2 == 1 ) then FF = S_V3xV3 ( F2_1, Laxis2 ) @@ -1505,14 +1511,14 @@ contains !********************************************************************** end if end function TPMInteractionF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMInteractionU ( Q, U, R1_1, R1_2, R2_1, R2_2, SType2 ) !!!!!!!!!!!!!!!! + integer(c_int) function TPMInteractionU ( Q, U, R1_1, R1_2, R2_1, R2_2, SType2 ) !!!!!!!!!!! real(c_double), intent(inout) :: Q, U real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 - integer(c_int), intent(in) :: SType2 + integer(c_int), intent(in) :: SType2 !------------------------------------------------------------------------------------------- real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, DR real(c_double) :: H, cosA, D1, D2, L1, L2, cosA2, t, W, Qa, Ua, Qb, Ub - integer(c_int) :: GeomID, SwitchID, IntSigna, IntSignb + integer(c_int) :: GeomID, SwitchID, IntSigna, IntSignb !------------------------------------------------------------------------------------------- R1 = 0.5d+00 * ( R1_1 + R1_2 ) R2 = 0.5d+00 * ( R2_1 + R2_2 ) @@ -1588,10 +1594,10 @@ contains !********************************************************************** real(c_double), intent(inout) :: Q, U real(c_double), dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2 real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 - integer(c_int), intent(in) :: SType2 + integer(c_int), intent(in) :: SType2 real(c_double), intent(in) :: Delta !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j, IntSign + integer(c_int) :: i, j, IntSign real(c_double) :: QQ, DD, D2 real(c_double), dimension(0:1,0:2) :: U1_1, U1_2, U2_1, U2_2 real(c_double), dimension(0:2) :: RR @@ -1635,14 +1641,14 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- subroutine TPMInit ( ChiIndM, ChiIndN ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int), intent(in) :: ChiIndM, ChiIndN + integer(c_int), intent(in) :: ChiIndM, ChiIndN real(c_double) :: RT, DX + character*512 :: PDate !------------------------------------------------------------------------------------------- TPPotType = TP_POT_MONO_R ! Here we calculate the radius of nanotubes - RT = TPBAcc * sqrt ( 3.0d+00 * ( ChiIndM * ChiIndM + ChiIndN * ChiIndN + ChiIndM * ChiIndN ) ) / M_2PI; - !print *, '(a,i3,a,i3,a,e18.10,a)', 'TPM is iniatized for (', ChiIndM, ',', ChiIndN, ') CNTs, RT = ', RT, ' A' + RT = TPBAcc * sqrt ( 3.0d+00 * ( ChiIndM * ChiIndM + ChiIndN * ChiIndN + ChiIndM * ChiIndN ) ) / M_2PI TPMChiIndM = ChiIndM TPMChiIndN = ChiIndN @@ -1660,6 +1666,21 @@ contains !********************************************************************** TPMASMin = sqr ( cos ( rad ( TPMAS ) ) ) TPMASMax = 1.0d+00 - TPGeomPrec TPMASDelta = TPMASMax - TPMASMin + + if ( TPMStartMode == 1 ) then + TPMUnitID = OpenFile ( TPMFile, 'rt', '' ) + read ( unit = TPMUnitID, fmt = '()' ) + read ( unit = TPMUnitID, fmt = '()' ) + read ( unit = TPMUnitID, fmt = '()' ) + else + TPMUnitID = OpenFile ( TPMFile, 'wt', '' ) + call fdate( PDate ) + write ( unit = TPMUnitID, fmt = '(a,a)' ) 'DATE ', PDate + write ( unit = TPMUnitID, fmt = '(a,i3,a,i3,a)' ) & + 'Tabulated data of the tubular potential for (', ChiIndM, ',', ChiIndN, ') CNTs' + write ( unit = TPMUnitID, fmt = '(a)' ) & + 'A. N. Volkov, L. V. Zhigilei, J. Phys. Chem. C 114, 5513-5531, 2010. doi: 10.1021/jp906142h' + end if call TPMSSTPInit () @@ -1669,6 +1690,8 @@ contains !********************************************************************** call TPMAInit ( - DX, DX, - DX, DX ) call TPMSTInit () + + call CloseFile ( TPMUnitID ) end subroutine TPMInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/lib/mesont/TubePotTrue.f90 b/lib/mesont/TubePotTrue.f90 index c43e194635..9b6a21bc13 100644 --- a/lib/mesont/TubePotTrue.f90 +++ b/lib/mesont/TubePotTrue.f90 @@ -25,7 +25,7 @@ module TubePotTrue !************************************************************ ! !--------------------------------------------------------------------------------------------------- ! -! This module implements calculation of true potential and transfer functions for interaction +! This module implements calculation of the true potential and transfer functions for interaction ! between two cylinder segments of nanotubes by direct integration over the surfaces of both ! segments. ! @@ -52,7 +52,7 @@ implicit none real(c_double) :: Psi, Theta, Phi ! Euler's angles real(c_double) :: R ! Segment radius real(c_double) :: L ! Segment length - integer(c_int) :: NX, NE ! Number of nodes for numerical integration + integer(c_int) :: NX, NE ! Number of nodes for numerical integration real(c_double) :: DX, DE ! Spacings real(c_double), dimension(0:2,0:2) :: M ! Transformation matrix real(c_double), dimension(0:TPTNXMAX-1,0:TPTNXMAX-1,0:2) :: Rtab! Node coordinates @@ -105,7 +105,7 @@ contains !********************************************************************** type(TPTSEG), intent(inout) :: S !------------------------------------------------------------------------------------------- real(c_double) :: X, Eps - integer(c_int) :: i, j + integer(c_int) :: i, j !------------------------------------------------------------------------------------------- X = - S%L / 2.0 call RotationMatrix3 ( S%M, S%Psi, S%Theta, S%Phi ) @@ -120,7 +120,7 @@ contains !********************************************************************** end subroutine TPTCalcSegNodeTable !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPTSetSegPosition1 ( S, Rcenter, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - type(TPTSEG), intent(inout) :: S + type(TPTSEG), intent(inout) :: S real(c_double), dimension(0:2), intent(in) :: Rcenter, Laxis real(c_double), intent(in) :: L !------------------------------------------------------------------------------------------- @@ -135,7 +135,7 @@ contains !********************************************************************** end subroutine TPTSetSegPosition1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPTSetSegPosition2 ( S, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - type(TPTSEG), intent(inout) :: S + type(TPTSEG), intent(inout) :: S real(c_double), dimension(0:2), intent(in) :: R1, R2 !------------------------------------------------------------------------------------------- real(c_double), dimension(0:2) :: R, Laxis @@ -148,10 +148,10 @@ contains !********************************************************************** call TPTSetSegPosition1 ( S, R, Laxis, L ) end subroutine TPTSetSegPosition2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(in) :: S1, S2 !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j + integer(c_int) :: i, j real(c_double) :: L1, L2, Displacement, D real(c_double), dimension(0:2) :: Laxis, Q, R !------------------------------------------------------------------------------------------- @@ -164,7 +164,8 @@ contains !********************************************************************** do i = 0, S2%NX - 1 do j = 0, S2%NE - 1 call LinePoint ( Displacement, Q, R, Laxis, S2%Rtab(i,j,0:2) ) - D = sqrt ( sqr ( Q(0) - S2%Rtab(i,j,0) ) + sqr ( Q(1) - S2%Rtab(i,j,1) ) + sqr ( Q(2) - S2%Rtab(i,j,2) ) ) + D = sqrt ( sqr ( Q(0) - S2%Rtab(i,j,0) ) + sqr ( Q(1) - S2%Rtab(i,j,1) ) & + + sqr ( Q(2) - S2%Rtab(i,j,2) ) ) if ( Displacement > L1 .and. Displacement < L2 .and. D < S1%R ) then TPTCheckIntersection = 1 return @@ -174,8 +175,8 @@ contains !********************************************************************** TPTCheckIntersection = 0 end function TPTCheckIntersection !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - type(TPTSEG), intent(in) :: S + integer(c_int) function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!! + type(TPTSEG), intent(in) :: S real(c_double), intent(out) :: Xmin, Xmax real(c_double), dimension(0:2), intent(in) :: Re !------------------------------------------------------------------------------------------- @@ -222,16 +223,16 @@ contains !********************************************************************** ! Tubular potential !--------------------------------------------------------------------------------------------------- - integer(c_int) function TPTPointPotential ( Q, U, F, R, S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function returns the potential U and force F applied to the atom in position R and + integer(c_int) function TPTPointPotential ( Q, U, F, R, S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This function returns the potential U and force F applied to an atom in position R and ! produced by the segment S. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), dimension(0:2), intent(out) :: F real(c_double), dimension(0:2), intent(in) :: R - type(TPTSEG), intent(in) :: S + type(TPTSEG), intent(in) :: S !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j + integer(c_int) :: i, j real(c_double), dimension(0:2) :: RR, FF real(c_double) :: QQ, UU, UUU, FFF, Rabs real(c_double) :: Coeff, Xmin, Xmax, X @@ -277,16 +278,16 @@ contains !********************************************************************** F = F * Coeff end function TPTPointPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTSectionPotential ( Q, U, F, M, S, i, Ssource ) !!!!!!!!!!!!!!!!!!!!!!! - ! This funcion returns the potential U, force F and torque M produced by the segment Ssource + integer(c_int) function TPTSectionPotential ( Q, U, F, M, S, i, Ssource ) !!!!!!!!!!!!!!!!!! + ! This function returns the potential U, force F and torque M produced by the segment Ssource ! and applied to the i-th circular cross-section of the segment S. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), dimension(0:2), intent(out) :: F, M - type(TPTSEG), intent(in) :: S, Ssource - integer(c_int), intent(in) :: i + type(TPTSEG), intent(in) :: S, Ssource + integer(c_int), intent(in) :: i !------------------------------------------------------------------------------------------- - integer(c_int) :: j + integer(c_int) :: j real(c_double), dimension(0:2) :: R, Fp, Mp, Lrad real(c_double) :: Qp, Up, Eps real(c_double) :: Coeff @@ -319,7 +320,7 @@ contains !********************************************************************** M = M * Coeff end function TPTSectionPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTSegmentPotential ( Q, U, F, M, S, Ssource ) !!!!!!!!!!!!!!!!!!!!!!!!!! + integer(c_int) function TPTSegmentPotential ( Q, U, F, M, S, Ssource ) !!!!!!!!!!!!!!!!!!!!!! ! This function returns the potential U, force F and torque M produced by the segment ! Ssource and applied to the segment S. !------------------------------------------------------------------------------------------- @@ -380,7 +381,7 @@ contains !********************************************************************** end subroutine TPTSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer(c_int) function TPTInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2 ) - ! This function returns the potential and forces appliend to the ends of segments. + ! This function returns the potential and forces applied to the ends of segments. !------------------------------------------------------------------------------------------- real(c_double), intent(out) :: Q, U real(c_double), dimension(0:2), intent(out) :: F1_1, F1_2, F2_1, F2_2 diff --git a/potentials/CNT_10_10/TPMA.xrs b/potentials/CNT_10_10/TPMA.xrs deleted file mode 100644 index 36541bbbf5..0000000000 --- a/potentials/CNT_10_10/TPMA.xrs +++ /dev/null @@ -1,21 +0,0 @@ - 10 10 20 - 1.38310128694773 - 1.35724209149762 - 1.32365748767981 - 1.29442479067528 - 1.26718337154593 - 1.24958609494311 - 1.24451289818673 - 1.23708643487397 - 1.22995846566678 - 1.22360130756455 - 1.21805814607791 - 1.21324855249729 - 1.20903840855456 - 1.20526799643516 - 1.20171559451527 - 1.19823073480505 - 1.19488513621680 - 1.19171041995885 - 1.18871927412810 - 1.18605209171295 diff --git a/potentials/CNT_10_10/TPMSSTP.xrs b/potentials/MESONT-TABTP_10_10.xrs similarity index 99% rename from potentials/CNT_10_10/TPMSSTP.xrs rename to potentials/MESONT-TABTP_10_10.xrs index 4b6186e819..370aaf6252 100644 --- a/potentials/CNT_10_10/TPMSSTP.xrs +++ b/potentials/MESONT-TABTP_10_10.xrs @@ -1,3 +1,6 @@ +DATE 27-MAR-20 +Tabulated data of the tubular potential for ( 10, 10) CNTs +A. N. Volkov, L. V. Zhigilei, J. Phys. Chem. C 114, 5513-5531, 2010. doi: 10.1021/jp906142h 10 10 1000 1000 0.00000000000000000E+00 0.00000000000000000E+00 -0.10557811324094224E-17 0.63808804195976917E-23 @@ -696450,3 +696453,24 @@ 0.00000000000000000E+00 0.00000000000000000E+00 0.00000000000000000E+00 0.00000000000000000E+00 0.00000000000000000E+00 0.00000000000000000E+00 + 10 10 20 + 1.38310128694773 + 1.35724209149762 + 1.32365748767981 + 1.29442479067528 + 1.26718337154593 + 1.24958609494311 + 1.24451289818673 + 1.23708643487397 + 1.22995846566678 + 1.22360130756455 + 1.21805814607791 + 1.21324855249729 + 1.20903840855456 + 1.20526799643516 + 1.20171559451527 + 1.19823073480505 + 1.19488513621680 + 1.19171041995885 + 1.18871927412810 + 1.18605209171295 diff --git a/src/Makefile b/src/Makefile index 4dae04db2f..9630e6e145 100644 --- a/src/Makefile +++ b/src/Makefile @@ -60,7 +60,7 @@ PACKAGE = asphere body class2 colloid compress coreshell dipole gpu \ PACKUSER = user-adios user-atc user-awpmd user-bocs user-cgdna user-cgsdk user-colvars \ user-diffraction user-dpd user-drude user-eff user-fep user-h5md \ - user-intel user-lb user-manifold user-meamc user-meso \ + user-intel user-lb user-manifold user-meamc user-mesodpd \ user-mgpt user-misc user-mofff user-molfile \ user-netcdf user-omp user-phonon user-plumed user-ptm user-qmmm \ user-qtb user-quip user-reaction user-reaxc user-scafacos user-smd user-smtbq \ diff --git a/src/USER-MESONT/README b/src/USER-MESONT/README index bb45e0ac34..8f481d9859 100644 --- a/src/USER-MESONT/README +++ b/src/USER-MESONT/README @@ -30,14 +30,12 @@ pair_style mesont/tpm cut table_path BendingMode TPMType be set to be at least max(2.0*L, sqrt(L^2/2 + (2.0*R + Tcut)^2)), where L is the maximum segment length, R is the maximum tube radius, and Tcut = 10.2 A is the maximum distance between surfaces of interacting - segments. + segments. However, the recommended cutoff is 3L. compute mesont This command allows evaluation of per atom and total values of stretching, bending, and intertube interaction components of energies. Use the following - flags to obtain specific values: 'estretch' and 'estretch_tot' are per atom (node) - and total stretching energies, 'ebend' and 'ebend_tot' are per atom and total - bending energy, 'etube' and 'etube_tot' are per atom and total intertube energies + flags: 'estretch', 'ebend', 'etube'. -- @@ -89,4 +87,3 @@ modeling and mesoscopic description, Phys. Rev. B 86, 165414, 2012. A. N. Volkov and A. H. Banna, Mesoscopic computational model of covalent cross-links and mechanisms of load transfer in cross-linked carbon nanotube films with continuous networks of bundles, Comp. Mater. Sci. 176, 109410, 2020. - diff --git a/src/USER-MESONT/compute_mesont.cpp b/src/USER-MESONT/compute_mesont.cpp index f34882f754..397b071a1b 100644 --- a/src/USER-MESONT/compute_mesont.cpp +++ b/src/USER-MESONT/compute_mesont.cpp @@ -34,25 +34,18 @@ ComputeMesoNT::ComputeMesoNT(LAMMPS *lmp, int narg, char **arg) : if (narg != 4) error->all(FLERR,"Illegal compute mesont command"); std::string ctype = arg[3]; if (ctype == "estretch") compute_type = ES; - else if (ctype == "estretch_tot") compute_type = ESTOT; else if (ctype == "ebend") compute_type = EB; - else if (ctype == "ebend_tot") compute_type = EBTOT; else if (ctype == "etube") compute_type = ET; - else if (ctype == "etube_tot") compute_type = ETTOT; else error->all(FLERR,"Illegal compute mesont command"); - if ((compute_type == ES) || (compute_type == EB) || (compute_type == ET)) { - peratom_flag = 1; - size_peratom_cols = 0; - peatomflag = 1; - timeflag = 1; - comm_reverse = 1; - nmax = 0; - } else { - timeflag = 1; - extscalar = 1; - scalar_flag = 1; - } + peratom_flag = 1; + size_peratom_cols = 0; + peatomflag = 1; + timeflag = 1; + comm_reverse = 1; + extscalar = 1; + scalar_flag = 1; + nmax = 0; } /* ---------------------------------------------------------------------- */ @@ -70,11 +63,11 @@ double ComputeMesoNT::compute_scalar() { int i; double* ptr = NULL; - if (compute_type == ESTOT) + if (compute_type == ES) ptr = static_cast(force->pair->extract("mesonttpm_Es_tot",i)); - else if (compute_type == EBTOT) + else if (compute_type == EB) ptr = static_cast(force->pair->extract("mesonttpm_Eb_tot",i)); - else if (compute_type == ETTOT) + else if (compute_type == ET) ptr = static_cast(force->pair->extract("mesonttpm_Et_tot",i)); else error->all(FLERR,"Illegal compute mesont command"); diff --git a/src/USER-MESONT/compute_mesont.h b/src/USER-MESONT/compute_mesont.h index 79df874f7f..e7165230a4 100644 --- a/src/USER-MESONT/compute_mesont.h +++ b/src/USER-MESONT/compute_mesont.h @@ -41,7 +41,7 @@ class ComputeMesoNT : public Compute { int nmax; double *energy; - enum ComputeType {ES, EB, ET, ESTOT, EBTOT, ETTOT}; + enum ComputeType {ES, EB, ET}; ComputeType compute_type; }; diff --git a/src/USER-MESONT/export_mesont.h b/src/USER-MESONT/export_mesont.h index b07e8e2a8a..08a5be21b5 100644 --- a/src/USER-MESONT/export_mesont.h +++ b/src/USER-MESONT/export_mesont.h @@ -19,8 +19,7 @@ extern "C" { // see ExportCNT.f90 in lib/mesont for function details void mesont_lib_TPBInit(); void mesont_lib_TPMInit(const int& M, const int& N); - void mesont_lib_SetTablePath(const char* TPMSSTPFile, const int& N1, - const char* TPMAFile, const int& N2); + void mesont_lib_SetTablePath(const char* TPMFile, const int& N); void mesont_lib_InitCNTPotModule(const int& STRModel, const int& STRParams, const int& YMType, const int& BNDModel, const double& Rref); diff --git a/src/USER-MESONT/pair_mesont_tpm.cpp b/src/USER-MESONT/pair_mesont_tpm.cpp index e8488b275a..c57dfbc3c2 100644 --- a/src/USER-MESONT/pair_mesont_tpm.cpp +++ b/src/USER-MESONT/pair_mesont_tpm.cpp @@ -585,19 +585,14 @@ void PairMESONTTPM::settings(int narg, char **arg){ for (j = i+1; j <= atom->ntypes; j++) cut[i][j] = cut_global; } - std::string TPMAFile; - if (narg > 1) { - std::string path = arg[1]; - if(path.back() != '/') path += '/'; - tab_path_length = path.length(); - memory->create(tab_path,tab_path_length,"pair:path"); - std::memcpy(tab_path, path.c_str(), tab_path_length); - std::string TPMSSTPFile = path + "TPMSSTP.xrs"; - TPMAFile = path + "TPMA.xrs"; - mesont_lib_SetTablePath(TPMSSTPFile.c_str(), TPMSSTPFile.length(), - TPMAFile.c_str(), TPMAFile.length()); - } - else TPMAFile = "TPMA.xrs"; + std::string TPMAFile = (narg > 1) ? arg[1] : "MESONT-TABTP.xrs"; + tab_path_length = TPMAFile.length(); + if (tab_path != NULL) memory->destroy(tab_path); + //c_str returns '\0' terminated string + memory->create(tab_path,tab_path_length+1,"pair:path"); + std::memcpy(tab_path, TPMAFile.c_str(), tab_path_length+1); + mesont_lib_SetTablePath(tab_path, tab_path_length); + if (narg > 2) { BendingMode = force->numeric(FLERR,arg[2]); if ((BendingMode < 0) || (BendingMode > 1)) @@ -613,6 +608,10 @@ void PairMESONTTPM::settings(int narg, char **arg){ int M, N; std::ifstream in(TPMAFile); if (!in.is_open()) error->all(FLERR,"Incorrect table path"); + std::string tmp; + std::getline(in,tmp); + std::getline(in,tmp); + std::getline(in,tmp); in >> M >> N; in.close(); mesont_lib_TPMInit(M, N); @@ -709,7 +708,7 @@ void PairMESONTTPM::write_restart_settings(FILE *fp){ fwrite(&TPMType,sizeof(int),1,fp); fwrite(&cut_global,sizeof(double),1,fp); fwrite(&tab_path_length,sizeof(int),1,fp); - fwrite(tab_path,tab_path_length,1,fp); + fwrite(tab_path,tab_path_length+1,1,fp); } /* ---------------------------------------------------------------------- @@ -729,23 +728,19 @@ void PairMESONTTPM::read_restart_settings(FILE *fp){ MPI_Bcast(&cut_global,1,MPI_DOUBLE,0,world); MPI_Bcast(&tab_path_length,1,MPI_INT,0,world); - memory->create(tab_path,tab_path_length,"pair:path"); - if (me == 0) fread(tab_path,tab_path_length,1,fp); - MPI_Bcast(tab_path,tab_path_length,MPI_CHAR,0,world); - - if (tab_path != NULL) { - std::string TPMSSTPFile = std::string(tab_path) + "TPMSSTP.xrs"; - std::string TPMAFile = std::string(tab_path) + "TPMA.xrs"; - mesont_lib_SetTablePath(TPMSSTPFile.c_str(), TPMSSTPFile.length(), - TPMAFile.c_str(), TPMAFile.length()); - } - - std::string TPMAFile = std::string((tab_path == NULL) ? "" : tab_path) - + "TPMA.xrs"; + if (tab_path != NULL) memory->destroy(tab_path); + memory->create(tab_path,tab_path_length+1,"pair:path"); + if (me == 0) fread(tab_path,tab_path_length+1,1,fp); + MPI_Bcast(tab_path,tab_path_length+1,MPI_CHAR,0,world); + mesont_lib_SetTablePath(tab_path,tab_path_length); mesont_lib_TPBInit(); int M, N; - std::ifstream in(TPMAFile); + std::ifstream in(tab_path); if (!in.is_open()) error->all(FLERR,"Incorrect table path"); + std::string tmp; + std::getline(in,tmp); + std::getline(in,tmp); + std::getline(in,tmp); in >> M >> N; in.close(); mesont_lib_TPMInit(M, N); @@ -789,4 +784,4 @@ void* PairMESONTTPM::extract(const char *str, int &){ else if (strcmp(str,"mesonttpm_Eb") == 0) return eatom_b; else if (strcmp(str,"mesonttpm_Et") == 0) return eatom_t; else return NULL; -}; \ No newline at end of file +}; diff --git a/src/atom_vec.cpp b/src/atom_vec.cpp index c4dd53ad18..7b89c2fd79 100644 --- a/src/atom_vec.cpp +++ b/src/atom_vec.cpp @@ -36,7 +36,6 @@ AtomVec::AtomVec(LAMMPS *lmp) : Pointers(lmp) forceclearflag = 0; size_data_bonus = 0; maxexchange = 0; - molecular = 0; kokkosable = 0; diff --git a/tools/mesont/CNTPot.f90 b/tools/mesont/CNTPot.f90 deleted file mode 100644 index 934d644c67..0000000000 --- a/tools/mesont/CNTPot.f90 +++ /dev/null @@ -1,734 +0,0 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - -module CNTPot !************************************************************************************* -! -! TMD Library: Mesoscopic potential for internal modes in CNTs -! -!--------------------------------------------------------------------------------------------------- -! -! Implementation of carbon nanotubes internal potentials: -! CNTSTRH0, harmonic stretching potential of type 0 with constant Young's modulus -! CNTSTRH1, harmonic stretching potential of type 1 with variable Youngs modulus -! CNTSTRNH0, non-harmonic stretching with fracture potential of type 0 -! CNTSTRNH1, non-harmonic stretching with fracture potential of type 1 -! CNTBNDH, harmonic bending potential -! CNTBNDHB, harmonic bending-buckling potential -! CNTBNDHBF, harmonic bending-buckling potential with fracture -! CNTTRS, torsion potential -! CNTBRT, breathing potential -! -! The functional form and force constants of harmonic streatching, bending and -! torsion potentials are taken from: -! L.V. Zhigilei, Ch. Wei, D. Srivastava, Phys. Rev. B 71, 165417 (2005) -! -! The model of stress-strain curve for non-harmonic potential with fracture -! is developed and parameterized with the help of constant -! -- Young's modulus (Pa), -! -- maximal linear strain (only for the NH potential of type 1) -! -- tensile strength (or fracture strain, Pa), -! -- strain at failure (or fracture strain) -! -- maximal strain. -! All these parameters are assumed to be independent of SWCNT radius or type. -! In this model true strain at failure CNTSTREft and true tensile strength -! CNTSTRSft are slightly different from imposed values CNTSTREf and CNTSTRSf. -! This difference is really small and is not taken into account. -! -! The non-harmonic stretching potentials of types 0 and 1 are different from -! each other by the functional form of the stress-strain curve -! -! Different parameterizations of CNTSTRH0, CNTSTRNH0 and CNTSTRNH1 potentials -! can be chosen, see subroutine CNTSTRSetParameterization -! -!--------------------------------------------------------------------------------------------------- -! -! Intel Fortran -! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 08.02.m.m.2.m, 2017 -! -!*************************************************************************************************** - -use TPMLib -use iso_c_binding, only : c_int, c_double, c_char -implicit none - -!--------------------------------------------------------------------------------------------------- -! Constants -!--------------------------------------------------------------------------------------------------- - integer(c_int), parameter :: CNTPOT_STRETCHING = 0 - integer(c_int), parameter :: CNTPOT_SBUCKLING = 1 - integer(c_int), parameter :: CNTPOT_SFRACTURE = 2 - - integer(c_int), parameter :: CNTPOT_BENDING = 3 - integer(c_int), parameter :: CNTPOT_BBUCKLING = 4 - integer(c_int), parameter :: CNTPOT_BFRACTURE = 5 - - integer(c_int), parameter :: CNTSTRMODEL_H0 = 0 ! Harmonic stetching model (constant Young's modulus) - integer(c_int), parameter :: CNTSTRMODEL_H1 = 1 ! Harmonic stretching model (Young's modulus depends on radius) - integer(c_int), parameter :: CNTSTRMODEL_NH0F = 2 ! Non-harmonic stretching with fracture, potential of type 0 - integer(c_int), parameter :: CNTSTRMODEL_NH1 = 3 ! Non-harmonic stretching without fracture, potential of type 1 - integer(c_int), parameter :: CNTSTRMODEL_NH1F = 4 ! Non-harmonic stretching with fracture, potential of type 1 - integer(c_int), parameter :: CNTSTRMODEL_H1B = 5 ! Harmonic stetching model + axial buckling - integer(c_int), parameter :: CNTSTRMODEL_H1BH = 6 ! Harmonic stetching model + axial buckling + hysteresis - - integer(c_int), parameter :: CNTBNDMODEL_H = 0 ! Harmonic bending model - integer(c_int), parameter :: CNTBNDMODEL_HB = 1 ! Harmonic bending - buckling model - integer(c_int), parameter :: CNTBNDMODEL_HBF = 2 ! Harmonic bending - buckling - fracture model - integer(c_int), parameter :: CNTBNDMODEL_HBH = 3 ! Harmonic bending - buckling + Hysteresis - - integer(c_int), parameter :: CNTPOTNMAX = 4000 ! Maximal number of points in interpolation tables - -!--------------------------------------------------------------------------------------------------- -! Parameters of potentials -!--------------------------------------------------------------------------------------------------- - - ! Stretching potential - - integer(c_int) :: CNTSTRModel = CNTSTRMODEL_H1! Type of the bending model - integer(c_int) :: CNTSTRParams = 0 ! Type of parameterization - integer(c_int) :: CNTSTRYMT = 0 ! Type of dependence of the Young's modulus on tube radius - - ! Parameters of non-harmonic potential and fracture model - real(c_double) :: CNTSTRR0 = 6.8d+00 ! Reference radius of nanotubes, A - ! (this parameter is not used for the model - ! paramerization, but only for calcuation of the - ! force constant in eV/A) - real(c_double) :: CNTSTRD0 = 3.4d+00 ! CNT wall thickness (diameter of carbon atom), A - real(c_double) :: CNTSTREmin = -0.4d+00 ! Minimal strain in tabulated potential - real(c_double) :: CNTSTREmax = 0.13d+00 ! Maximal strain in tabulated potential. Simultaneously, U=0 if E> CNTSTREmax - real(c_double) :: CNTSTREl = 5.0d-02 ! Maximal linear strain - real(c_double) :: CNTSTREf = 12.0d-02 ! Strain at failure - real(c_double) :: CNTSTRS0 = 0.850e+12 ! Young's modulus, Pa - real(c_double) :: CNTSTRSl ! Maximal linear strees, Pa - real(c_double) :: CNTSTRSf = 75.0d+09 ! Tensile strength, Pa - real(c_double) :: CNTSTRF0 ! Elastic force constant, eV/A**2 - real(c_double) :: CNTSTRFl ! Maximal linear force, eV/A**2 - real(c_double) :: CNTSTRFf ! Tensile force at failure, eV/A**2 - real(c_double) :: CNTSTRSi ! Maximal available stress (reference parameter, not used in the model), Pa - real(c_double) :: CNTSTRDf ! dF/dE at failure - real(c_double) :: CNTSTRAA, CNTSTRBB ! - real(c_double) :: CNTSTRAAA, CNTSTRBBB ! | Auxilary constants - real(c_double) :: CNTSTRUl, CNTSTRUf ! / - - ! Axial buckling - hysteresis approch - real(c_double) :: CNTSTREc = -0.0142d+00 ! The minimal buckling strain - real(c_double) :: CNTSTREc1 = -0.04d+00 ! Critical axial buckling strain - real(c_double) :: CNTSTREc2 = -0.45d+00 ! Maximal buckling strain (the pot is harmonic for larger strains(in abs val)) - - !real(c_double) :: CNTSTRAmin - !real(c_double) :: CNTSTRAmax - !real(c_double) :: CNTSTRDA - - ! Bending potential - - integer(c_int) :: CNTBNDModel = CNTBNDMODEL_H ! Type of the bending model - !real(c_double) :: CNTBNDAmin - !real(c_double) :: CNTBNDAmax - !real(c_double) :: CNTBNDDA - ! Buckling model parameters - real(c_double) :: CNTBNDN = 1.0d+00 ! Buckling exponent - real(c_double) :: CNTBNDB = 0.68d+00 ! Buckling number - real(c_double) :: CNTBNDR = 275.0d+00 ! Critical radius of curvarure, A - ! This is mean value for (10,10) SWCNT - real(c_double) :: CNTBNDTF = M_PI * 120.0d+00 / 180.0d+00 ! Fracture buckling angle, rad - real(c_double) :: CNTBNDN1 - real(c_double) :: CNTBNDC2 - -contains !****************************************************************************************** - -!--------------------------------------------------------------------------------------------------- -! Stretching potential -!--------------------------------------------------------------------------------------------------- - - subroutine CNTSTRSetParameterization ( PType ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Setup parameters for further parameterization of streatching models - ! References: - ! [1] Yu M.-F. et al., Phys. Rev. Lett. 84(24), 5552 (2000) - ! [2] Liew K.M. et al., Acta Materialia 52, 2521 (2004) - ! [3] Mielke S.L. et al., Chem. Phys. Lett. 390, 413 (2004) - ! [4] Zhigilei L.V. et al., Phys. Rev. B 71, 165417 (2005) - ! [5] Kelly B.T., Physics of graphite, 1981 - !------------------------------------------------------------------------------------------- - integer(c_int), intent(in) :: PType - !------------------------------------------------------------------------------------------- - select case ( PType ) - case ( 0 ) ! This parametrization is based on averaged exp. data of Ref. [1] - CNTSTRR0 = 6.8d+00 ! Ref. [1] - CNTSTRD0 = 3.4d+00 ! Ref. [1] - CNTSTREmin = -0.4d+00 ! Chosen arbitrary - CNTSTREmax = 3.64d-02 ! = CNTSTREf + 0.005 - CNTSTREl = 2.0d-02 ! Chosen arbitrary - CNTSTREf = 3.14d-02 ! Ref. [1] - CNTSTRS0 = 1.002e+12 ! Ref. [1] - CNTSTRSf = 30.0d+09 ! Ref. [1] - case ( 1 ) ! This parameterization is taken from Ref. [2] for (10,10) SWCNT - ! These values are obtained in MD simulatuions with REBO potential - ! Values of Young's modulus, Tensile strenght and stress here - ! are close to those obtained in Ref. [3] for pristine (defectless) - ! (5,5) SWCNT in semiempirical QM calcuilations based on PM3 model - CNTSTRR0 = 6.785d+00 ! Calculated with usual formula for (10,10) CNT - CNTSTRD0 = 3.35d+00 ! Ref. [2] - CNTSTREmin = -0.4d+00 ! Chosen arbitrary - CNTSTREmax = 28.4d-02 ! = CNTSTREf + 0.005 - CNTSTREl = 5.94d-02 ! Ref. [2] - CNTSTREf = 27.9d-02 ! Corresponds to Maximal strain in Ref. [2] - CNTSTRS0 = 1.031e+12 ! Ref. [2] - CNTSTRSf = 148.5d+09 ! Corresponds to Tensile strength in Ref. [2] - case ( 2 ) ! This parametrization is taken from Ref. [3] for (5,5) SWCNT - ! with one atom vacancy defect obtained by semiempirical QM PM3 model - CNTSTRR0 = 3.43d+00 ! Ref. [3] - CNTSTRD0 = 3.4d+00 ! Ref. [3] - CNTSTREmin = -0.4d+00 ! Chosen arbitrary - CNTSTREmax = 15.8d-02 ! = CNTSTREf + 0.005 - CNTSTREl = 6.00d-02 ! Chosed similar to Ref. [2] - CNTSTREf = 15.3d-02 ! Ref. [3] - CNTSTRS0 = 1.100e+12 ! Ref. [3] - CNTSTRSf = 100.0d+09 ! Ref. [3] - case ( 3 ) ! This special parameterization changes the only value of Young's modulus - ! with accordance with the stretching constant in Ref. [4] - CNTSTRS0 = ( 86.64d+00 + 100.56d+00 * CNTSTRR0 ) * K_MDFU / ( M_2PI * CNTSTRR0 * CNTSTRD0 * 1.0e-20 ) ! Ref. [4] - case ( 4 ) ! This special parameterization changes the only value of Young's modulus - ! making it equal to the in-plane Young's modulus of graphite - CNTSTRR0 = 6.785d+00 ! Calculated with usual formula for (10,10) CNT - CNTSTRD0 = 3.4d+00 ! Ref. [1] - CNTSTRS0 = 1.06e+12 ! Ref. [5] - end select - end subroutine CNTSTRSetParameterization !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! Stretching without fracture, harmonic potential - ! - - integer(c_int) function CNTSTRH0Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Young's modulus is independent of R - !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: U, dUdL - real(c_double), intent(in) :: L, R0, L0 - real(c_double) :: E - !------------------------------------------------------------------------------------------- - E = ( L - L0 ) / L0 - dUdL = R0 * CNTSTRF0 * E - U = 0.5d+00 * L0 * E * dUdL - CNTSTRH0Calc = CNTPOT_STRETCHING - end function CNTSTRH0Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function CNTSTRH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Young's modulus depends on R, see [4] - !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: U, dUdL - real(c_double), intent(in) :: L, R0, L0 - real(c_double) :: E, K - !------------------------------------------------------------------------------------------- - E = ( L - L0 ) / L0 - K = 86.64d+00 + 100.56d+00 * R0 - dUdL = K * E - U = 0.5d+00 * L0 * E * dUdL - CNTSTRH1Calc = CNTPOT_STRETCHING - end function CNTSTRH1Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! Stretching without fracture, harmonic potential, with axial buckling without hysteresis - ! - - integer(c_int) function CNTSTRH1BCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Young's modulus depends on R, see [4] - ! Axial buckling without hysteresis - !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: U, dUdL - real(c_double), intent(in) :: L, R0, L0 - real(c_double) :: E, K, Kbcl, dUbcl, d, ud - !------------------------------------------------------------------------------------------- - E = ( L - L0 ) / L0 - K = 86.64d+00 + 100.56d+00 * R0 - Kbcl = -10.98d+00 * L0 - if ( E .gt. CNTSTREc ) then !Harmonic stretching - dUdL = K * E - U = 0.5d+00 * L0 * E * dUdL - CNTSTRH1BCalc = CNTPOT_STRETCHING - else if ( E .gt. CNTSTREc2 ) then !Axial buckling - dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc - U = Kbcl * E + dUbcl - dUdL = Kbcl / L0 - CNTSTRH1BCalc = CNTPOT_STRETCHING !should be buckling, but doesn't work for some reason... - else !Return to harmonic potential - d = -0.0142794 - dUdL = K * ( d + E - CNTSTREc2 ) - dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc + Kbcl * CNTSTREc2 - Ud = 0.5d+00 * L0 * K * d * d - U = 0.5d+00 * L0 * (d+E-CNTSTREc2) * dUdL + dUbcl - Ud - CNTSTRH1BCalc = CNTPOT_STRETCHING - end if - end function CNTSTRH1BCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! Stretching without fracture, harmonic potential, with axial buckling with hysteresis - ! - - integer(c_int) function CNTSTRH1BHCalc ( U, dUdL, L, R0, L0, ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!! - ! Young's modulus depends on R, see [4] - !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: U, dUdL, Ebuc - real(c_double), intent(in) :: L, R0, L0 - integer(c_int), intent(in) :: ABF - !------------------------------------------------------------------------------------------- - real(c_double) :: E, K, dUbcl, Ebcl, Kbcl, Edu - real(c_double) :: C, DE, t - !------------------------------------------------------------------------------------------- - E = ( L - L0 ) / L0 - K = 86.64d+00 + 100.56d+00 * R0 - Kbcl = -10.98d+00 * L0 - if ( E .gt. CNTSTREc ) then ! harmonic potential - no buckling - dUdL = K * E - U = 0.5d+00 * L0 * E * dUdL - CNTSTRH1BHCalc = CNTPOT_STRETCHING - Ebuc = 0.0d+00 - else if ( E .gt. CNTSTREc1 ) then !above minimal buckling strain, but not at critical strain - if ( ABF .eq. 0 ) then ! not buckled. Continue harmonic potential - dUdL = K * E - U = 0.5d+00 * L0 * E * dUdL - CNTSTRH1BHCalc = CNTPOT_STRETCHING - Ebuc = 0.0d+00 - else ! relaxing from buckled state. Use buckling potential - dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc - U = Kbcl * E + dUbcl - dUdL = Kbcl / L0 - CNTSTRH1BHCalc = CNTPOT_SBUCKLING - Ebuc = 0.0d+00 - end if - else if( E .gt. CNTSTREc2 ) then ! Axial buckling strain region - if ( ABF .eq. 0 ) then !newly buckled - dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc - U = Kbcl * E + dUbcl - dUdL = Kbcl / L0 - CNTSTRH1BHCalc = CNTPOT_SBUCKLING - Ebuc = 0.5d+00 * L0 * K * CNTSTREc1 * CNTSTREc1 - Kbcl * CNTSTREc1 - dUbcl - else ! already buckled - dUbcl = 0.5d+00 * L0 * K * CNTSTREc * CNTSTREc - Kbcl * CNTSTREc - U = Kbcl * E + dUbcl - dUdL = Kbcl / L0 - CNTSTRH1BHCalc = CNTPOT_SBUCKLING - Ebuc = 0.0d+00 - end if - else ! Maximum strain and return to harmonic potential - dUdL = K * E - U = 0.5d+00 * L0 * E * dUdL - CNTSTRH1BHCalc = CNTPOT_STRETCHING - Ebuc = 0.0d+00 - end if - end function CNTSTRH1BHCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! Stretching with fracture, non-harmonic potential of type 0 - ! - - integer(c_int) function CNTSTRNH0FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: U, dUdL - real(c_double), intent(in) :: L, R0, L0 - real(c_double) :: E, DE, t - !------------------------------------------------------------------------------------------- - E = ( L - L0 ) / L0 - if ( E < CNTSTREf ) then - dUdL = ( CNTSTRAA - CNTSTRBB * E ) * E - U = ( CNTSTRAAA - CNTSTRBBB * E ) * E * E - CNTSTRNH0FCalc = CNTPOT_STRETCHING - else - dUdL = 0.0d+00 - U = 0.0d+00 - CNTSTRNH0FCalc = CNTPOT_SFRACTURE - end if - U = L0 * R0 * U - dUdL = R0 * dUdL - end function CNTSTRNH0FCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine CNTSTRNH0Init () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) :: S - !------------------------------------------------------------------------------------------- - S = M_2PI * CNTSTRD0 * 1.0e-20 / K_MDFU - CNTSTRSl = CNTSTRS0 * CNTSTREl - CNTSTRF0 = CNTSTRS0 * S - CNTSTRFl = CNTSTRSl * S - CNTSTRFf = CNTSTRSf * S - CNTSTRAA = CNTSTRF0 - CNTSTRBB = ( CNTSTRF0 * CNTSTREf - CNTSTRFf ) / ( CNTSTREf * CNTSTREf ) - CNTSTRAAA= CNTSTRAA / 2.0d+00 - CNTSTRBBB= CNTSTRAA / 3.0d+00 - CNTSTRUl = 0.0d+00 - CNTSTRUf = ( CNTSTRAAA - CNTSTRBBB * CNTSTREf ) * CNTSTREf * CNTSTREf - ! These two values are not defined yet - CNTSTRSi = 0.0d+00 - CNTSTRDf = 0.0d+00 - end subroutine CNTSTRNH0Init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! Stretching without fracture, non-harmonic potential of type 1 - ! - - integer(c_int) function CNTSTRNH1Calc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: U, dUdL - real(c_double), intent(in) :: L, R0, L0 - real(c_double) :: E, C, DE, t - !------------------------------------------------------------------------------------------- - E = ( L - L0 ) / L0 - if ( E < CNTSTREl ) then - dUdL = CNTSTRF0 * E - U = 0.5d+00 * E * dUdL - CNTSTRNH1Calc = CNTPOT_STRETCHING - else - DE = E - CNTSTREl - C = 1.0 + CNTSTRBB * DE - dUdL = CNTSTRFl + CNTSTRAA * ( 1.0d+00 - 1.0d+00 / C ) - U = CNTSTRUl + CNTSTRAAA * DE - CNTSTRBBB * dlog ( C ) - end if - CNTSTRNH1Calc = CNTPOT_STRETCHING - U = L0 * R0 * U - dUdL = R0 * dUdL - end function CNTSTRNH1Calc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! Stretching with fracture, non-harmonic potential of type 1 - ! - - integer(c_int) function CNTSTRNH1FCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: U, dUdL - real(c_double), intent(in) :: L, R0, L0 - real(c_double) :: E, C, DE, t -!character(c_char)*512 :: Msg - !------------------------------------------------------------------------------------------- - E = ( L - L0 ) / L0 - if ( E < CNTSTREl ) then - dUdL = CNTSTRF0 * E - U = 0.5d+00 * E * dUdL - CNTSTRNH1FCalc = CNTPOT_STRETCHING - else if ( E < CNTSTREf ) then - DE = E - CNTSTREl - C = 1.0 + CNTSTRBB * DE - dUdL = CNTSTRFl + CNTSTRAA * ( 1.0d+00 - 1.0d+00 / C ) - U = CNTSTRUl + CNTSTRAAA * DE - CNTSTRBBB * dlog ( C ) - CNTSTRNH1FCalc = CNTPOT_STRETCHING - else -!write ( Msg, * ) 'F Strains', E, CNTSTREf -!call PrintStdLogMsg ( Msg ) - dUdL = 0.0d+00 - U = 0.0d+00 - CNTSTRNH1FCalc = CNTPOT_SFRACTURE - end if - U = L0 * R0 * U - dUdL = R0 * dUdL - end function CNTSTRNH1FCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine CNTSTRNH1Init () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) :: S, C, E, t - integer(c_int) :: i, CaseID - !------------------------------------------------------------------------------------------- - S = M_2PI * CNTSTRD0 * 1.0e-20 / K_MDFU - CNTSTRSl = CNTSTRS0 * CNTSTREl - CNTSTRF0 = CNTSTRS0 * S - CNTSTRFl = CNTSTRSl * S - CNTSTRFf = CNTSTRSf * S - CNTSTRAA = ( CNTSTRFf - CNTSTRFl ) * ( CNTSTREf * CNTSTRF0 - CNTSTRFl ) / ( CNTSTREf * CNTSTRF0 - CNTSTRFf ) - CNTSTRBB = CNTSTRF0 / CNTSTRAA - CNTSTRAAA= CNTSTRFl + CNTSTRAA - CNTSTRBBB= CNTSTRAA / CNTSTRBB - CNTSTRSi = CNTSTRSl + CNTSTRAA / S - C = 1.0 + CNTSTRBB * ( CNTSTREf - CNTSTREl ) - CNTSTRDf = CNTSTRF0 / C / C - CNTSTRUl = 0.5d+00 * CNTSTRFl * CNTSTREl - CNTSTRUf = CNTSTRUl + ( CNTSTRFl + CNTSTRAA ) * ( CNTSTREf - CNTSTREl ) - CNTSTRAA * dlog ( C ) / CNTSTRBB - end subroutine CNTSTRNH1Init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! General - ! - - !integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTSTRCalc ( U, dUdL, L, R0, L0 , ABF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: U, dUdL, Ebuc - real(c_double), intent(in) :: L, R0, L0 - integer(c_int), intent(in) :: ABF - !------------------------------------------------------------------------------------------- - Ebuc = 0.0d+00 - select case ( CNTSTRModel ) - case ( CNTSTRMODEL_H0 ) - CNTSTRCalc = CNTSTRH0Calc ( U, dUdL, L, R0, L0 ) - case ( CNTSTRMODEL_H1 ) - CNTSTRCalc = CNTSTRH1Calc ( U, dUdL, L, R0, L0 ) - case ( CNTSTRMODEL_NH0F ) - CNTSTRCalc = CNTSTRNH0FCalc ( U, dUdL, L, R0, L0 ) - case ( CNTSTRMODEL_NH1 ) - CNTSTRCalc = CNTSTRNH1Calc ( U, dUdL, L, R0, L0 ) - case ( CNTSTRMODEL_NH1F ) - CNTSTRCalc = CNTSTRNH1FCalc ( U, dUdL, L, R0, L0 ) - case ( CNTSTRMODEL_H1B ) - CNTSTRCalc = CNTSTRH1BCalc ( U, dUdL, L, R0, L0 ) - case ( CNTSTRMODEL_H1BH ) - CNTSTRCalc = CNTSTRH1BHCalc ( U, dUdL, L, R0, L0, ABF, Ebuc ) - end select - end function CNTSTRCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine CNTSTRInit ( STRModel, STRParams, YMType, Rref ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int), intent(in) :: STRModel, STRParams, YMType - real(c_double), intent(in) :: Rref - !real(c_double) :: A - !integer(c_int) :: i - !------------------------------------------------------------------------------------------- - CNTSTRModel = STRModel - CNTSTRParams = STRParams - CNTSTRYMT = YMType - if ( STRModel .ne. CNTSTRMODEL_H1 ) then - call CNTSTRSetParameterization ( STRParams ) - if ( YMType == 2 ) then - call CNTSTRSetParameterization ( 4 ) - else if ( YMType == 1 ) then - CNTSTRR0 = Rref - call CNTSTRSetParameterization ( 3 ) - end if - if ( STRModel == CNTSTRMODEL_NH0F ) then - call CNTSTRNH0Init () - else - call CNTSTRNH1Init () - end if - end if - !CNTSTRAmin = -0.4d+00 - !CNTSTRAmax = 0.4d+00 - !CNTSTRDA = ( CNTSTRAmax - CNTSTRAmin ) / ( CNTPOTN - 1 ) - !A = CNTSTRAmin - !do i = 0, CNTPOTN - 1 - ! CNTSTRU(i) = 0.5d+00 * A * A - ! CNTSTRdUdA(i) = A - ! A = A + CNTSTRDA - !end do - end subroutine CNTSTRInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!--------------------------------------------------------------------------------------------------- -! Bending potentials -!--------------------------------------------------------------------------------------------------- - - subroutine BendingGradients ( K, G0, G1, G2, R0, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This functions calculates degreeiest for bending forces - !------------------------------------------------------------------------------------------- - real(c_double), intent(inout) :: K - real(c_double), dimension(0:2), intent(inout) :: G0, G1, G2 - real(c_double), dimension(0:2), intent(in) :: R0, R1, R2 - real(c_double), dimension(0:2) :: DR0, DR2 - real(c_double) :: L0, L2 - !------------------------------------------------------------------------------------------- - DR0 = R0 - R1 - DR2 = R2 - R1 - L0 = S_V3norm3 ( DR0 ) - L2 = S_V3norm3 ( DR2 ) - DR0 = DR0 / L0 - DR2 = DR2 / L2 - K = S_V3xV3 ( DR0, DR2 ) - G0 = DR2 - K * DR0 - G2 = DR0 - K * DR2 - G0 = G0 / L0 - G2 = G2 / L2 - G1 = - ( G0 + G2 ) - end subroutine BendingGradients !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function CNTBNDHCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Bending model of type 0: - ! Harmonic bending potential - !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: U, dUdC - real(c_double), intent(in) :: C, R0, L0 - real(c_double) :: E, K - !------------------------------------------------------------------------------------------- - E = 1.0d+00 - C - K = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0 - U = K * ( 1.0d+00 + C ) / E - dUdC = 2.0d+00 * K / ( E * E ) - CNTBNDHCalc = CNTPOT_BENDING - end function CNTBNDHCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function CNTBNDHBCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Bending model of type 1: - ! Harmonic bending potential with buckling - !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: U, dUdC - real(c_double), intent(in) :: C, R0, L0 - real(c_double) :: E1, E2, C2, Kbnd, Kbcl, Theta, DUbcl - !------------------------------------------------------------------------------------------- - E1 = 1.0d+00 - C - E2 = 1.0d+00 + C - ! Calculate the square of curvature - C2 = 4.0d+00 * E2 / ( L0 * L0 * E1 ) - ! Check the condition for buckling - if ( C2 .ge. CNTBNDC2 ) then ! Buckling takes place - Theta= M_PI - acos ( C ) - Kbnd = 63.8d+00 * R0**2.93d+00 - Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= Kbnd * ( CNTBNDB * ( M_PI - 2.0d+00 * atan ( 2.0 * CNTBNDR / L0 ) ) - 0.5d+00 * L0 / CNTBNDR ) / CNTBNDR - U = Kbcl * abs( Theta )**CNTBNDN - DUbcl - dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) - CNTBNDHBCalc = CNTPOT_BBUCKLING - else ! Harmonic bending - Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0 - U = Kbnd * E2 / E1 - dUdC = 2.0d+00 * Kbnd / ( E1 * E1 ) - CNTBNDHBCalc = CNTPOT_BENDING - end if - end function CNTBNDHBCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function CNTBNDHBFCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: U, dUdC - real(c_double), intent(in) :: C, R0, L0 - real(c_double) :: E1, E2, C2, Kbnd, Kbcl, Theta, DUbcl - !------------------------------------------------------------------------------------------- - E1 = 1.0d+00 - C - E2 = 1.0d+00 + C - ! Calculate the square of curvature - C2 = 4.0d+00 * E2 / ( L0 * L0 * E1 ) - ! Check the condition for buckling - if ( C2 .ge. CNTBNDC2 ) then ! Buckling takes place - Theta= M_PI - acos ( C ) - if ( Theta > CNTBNDTF ) then ! Fracture takes place - U = 0.0d+00 - dUdC = 0.0d+00 - CNTBNDHBFCalc = CNTPOT_BFRACTURE - else - Kbnd = 63.8d+00 * R0**2.93d+00 - Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= Kbnd * ( CNTBNDB * ( M_PI - 2.0d+00 * atan ( 2.0 * CNTBNDR / L0 ) ) - 0.5d+00 * L0 / CNTBNDR ) / CNTBNDR - U = Kbcl * abs ( Theta )**CNTBNDN - DUbcl - dUdC = Kbcl * CNTBNDN * abs ( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) - CNTBNDHBFCalc = CNTPOT_BBUCKLING - end if - else ! Harmonic bending - Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0 - U = Kbnd * E2 / E1 - dUdC = 2.0d+00 * Kbnd / ( E1 * E1 ) - CNTBNDHBFCalc = CNTPOT_BENDING - end if - end function CNTBNDHBFCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function CNTBNDHBHCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!! - ! Bending model of type 1: - ! Harmonic bending potential with buckling with hysteresis approch. - !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: U, dUdC, Ebuc - real(c_double), intent(in) :: C , R0, L0 - integer(c_int), intent(in) :: BBF - real(c_double) :: E1, E2, C2, Kbnd, Kbcl,Theta,DUbcl, Ubcl, Cmin,Rmax - !------------------------------------------------------------------------------------------- - Rmax = 340.0d+00 - Cmin = 1.0/(Rmax*Rmax) - E1 = 1.0d+00 - C - E2 = 1.0d+00 + C - ! Calculate the square of curvature - C2 = 4.0d+00 * E2 / ( L0 * L0 * E1 ) - Theta = M_PI - acos ( C ) - if ( C2 .lt. Cmin ) then ! Harmonic bending - Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0 - U = Kbnd * E2 / E1 - dUdC = 2.0d+00 * Kbnd / ( E1 * E1 ) - CNTBNDHBHCalc = CNTPOT_BENDING - Ebuc = 0.0 - else if ( C2 .ge. Cmin .and. C2 .lt. CNTBNDC2 ) then !Potential here depends on buckling flag of node - if ( BBF .eq. 0 ) then ! Not buckled yet. Continue harmonic bending - Kbnd = 2.0d+00 * ( 63.8d+00 * R0**2.93d+00 ) / L0 - U = Kbnd * E2 / E1 - dUdC = 2.0d+00 * Kbnd / ( E1 * E1 ) - CNTBNDHBHCalc = CNTPOT_BENDING - Ebuc = 0.0d+00 - else ! Already has been buckled or is buckled. Use buckling potential until Cmin. - Theta= M_PI - acos ( C ) - Kbnd = 63.8d+00 * R0**2.93d+00 - Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN - U = Kbcl * abs( Theta )**CNTBNDN + DUbcl - dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) - Ebuc = 0.0d+00 - CNTBNDHBHCalc = CNTPOT_BBUCKLING - end if - else ! Greater than buckling critical point - if ( BBF .eq. 1 ) then ! Already buckled - Theta= M_PI - acos ( C ) - Kbnd = 63.8d+00 * R0**2.93d+00 - Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN - U = Kbcl * abs( Theta )**CNTBNDN + DUbcl - dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) - Ebuc = 0.0d00 - CNTBNDHBHCalc = CNTPOT_BBUCKLING - else ! Newly buckled - Theta= M_PI - acos ( C ) - Kbnd = 63.8d+00 * R0**2.93d+00 - Kbcl = CNTBNDB * Kbnd / CNTBNDR - DUbcl= 2.0d+00*Kbnd * (1.0d+00+cos(l0/Rmax+M_PI))/(1.0d+00-cos(l0/Rmax+M_PI))/L0-Kbcl*abs(l0/Rmax)**CNTBNDN - U = Kbcl * abs( Theta )**CNTBNDN + DUbcl - dUdC = Kbcl * CNTBNDN * abs( Theta )**CNTBNDN1 / sqrt ( 1.0d+00 - C * C ) - Ebuc = 2.0d+00*Kbnd * (1.0d+00+cos(l0/CNTBNDR+M_PI)) / (1.0d+00-cos(l0/CNTBNDR+M_PI))/L0- Kbcl*abs(l0/CNTBNDR)**CNTBNDN-dUbcl - CNTBNDHBHCalc = CNTPOT_BBUCKLING - end if - end if - end function CNTBNDHBHCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! - ! General - ! - -! integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function CNTBNDCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) !!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: U, dUdC, Ebuc - real(c_double), intent(in) :: C, R0, L0 - integer(c_int), intent(in) :: BBF - !------------------------------------------------------------------------------------------- - Ebuc = 0.0d+00 - select case ( CNTBNDModel ) - case ( CNTBNDMODEL_H ) - CNTBNDCalc = CNTBNDHCalc ( U, dUdC, C, R0, L0 ) - case ( CNTBNDMODEL_HB ) - CNTBNDCalc = CNTBNDHBCalc ( U, dUdC, C, R0, L0 ) - case ( CNTBNDMODEL_HBF ) - CNTBNDCalc = CNTBNDHBFCalc ( U, dUdC, C, R0, L0 ) - case ( CNTBNDMODEL_HBH ) - CNTBNDCalc = CNTBNDHBHCalc ( U, dUdC, C, R0, L0, BBF, Ebuc ) - end select - end function CNTBNDCalc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine CNTBNDInit ( BNDModel ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int), intent(in) :: BNDModel - real(c_double) :: A, E - integer(c_int) :: i - !------------------------------------------------------------------------------------------- - CNTBNDModel= BNDModel - CNTBNDN1 = CNTBNDN - 1.0d+00 - CNTBNDC2 = 1.0d+00 / ( CNTBNDR * CNTBNDR ) - !CNTBNDAmin = -1.0d+00 - !CNTBNDAmax = 0.99d+00 - !CNTBNDDA = ( CNTBNDAmax - CNTBNDAmin ) / ( CNTPOTN - 1 ) - !A = CNTBNDAmin - !do i = 0, CNTPOTN - 1 - ! E = 1.0d+00 - A - ! CNTBNDU(i) = 2.0d+00 * ( 1.0d+00 + A ) / E - ! CNTBNDdUdA(i) = 4.0d+00 / E / E - ! A = A + CNTBNDDA - !end do - end subroutine CNTBNDInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!--------------------------------------------------------------------------------------------------- -! Module initialization -!--------------------------------------------------------------------------------------------------- - - subroutine InitCNTPotModule ( STRModel, STRParams, YMType, BNDModel, Rref ) !!!!!!!!!!!!!!!! - integer(c_int), intent(in) :: STRModel, STRParams, YMType, BNDModel - real(c_double), intent(in) :: Rref - !------------------------------------------------------------------------------------------- - call CNTSTRInit ( STRModel, STRParams, YMType, Rref ) - call CNTBNDInit ( BNDModel ) - end subroutine InitCNTPotModule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -end module CNTPot !********************************************************************************* diff --git a/tools/mesont/ExportCNT.f90 b/tools/mesont/ExportCNT.f90 deleted file mode 100644 index 3f3c8dba80..0000000000 --- a/tools/mesont/ExportCNT.f90 +++ /dev/null @@ -1,125 +0,0 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Maxim Shugaev (UVA), mvs9t@virginia.edu -!------------------------------------------------------------------------- - -module ExportCNT !******************************************************************************* - use iso_c_binding - use CNTPot - use TPMLib - use TubePotMono - use TPMForceField - use iso_c_binding, only : c_int, c_double, c_char - implicit none -contains - subroutine InitCNTPotModule_(STRModel, STRParams, YMType, BNDModel, Rref) & - bind(c, name = "mesont_lib_InitCNTPotModule") - integer(c_int), intent(in) :: STRModel, STRParams, YMType, BNDModel - real(c_double), intent(in) :: Rref - - call InitCNTPotModule(STRModel, STRParams, YMType, BNDModel, Rref) - endsubroutine - - subroutine TPBInit_() & - bind(c, name = "mesont_lib_TPBInit") - - call TPBInit() - endsubroutine - - subroutine TPMInit_(M, N) & - bind(c, name = "mesont_lib_TPMInit") - integer(c_int), intent(in) :: M, N - - call TPMInit(M, N) - endsubroutine - - subroutine SetTablePath_(TPMSSTPFile_, N1, TPMAFile_, N2) & - bind(c, name = "mesont_lib_SetTablePath") - integer(c_int), intent(in) :: N1, N2 - character(c_char), intent(in), dimension(N1) :: TPMSSTPFile_ - character(c_char), intent(in), dimension(N2) :: TPMAFile_ - integer :: i - - do i = 1, len(TPMSSTPFile) - if (i <= N1) then - TPMSSTPFile(i:i) = TPMSSTPFile_(i) - else - TPMSSTPFile(i:i) = ' ' - endif - enddo - do i = 1, len(TPMAFile) - if (i <= N2) then - TPMAFile(i:i) = TPMAFile_(i) - else - TPMAFile(i:i) = ' ' - endif - enddo - endsubroutine - - function get_R_ () & - bind(c, name = "mesont_lib_get_R") - real(c_double) :: get_R_ - get_R_ = TPMR1 - return - endfunction - - - subroutine TubeStretchingForceField_(U1, U2, F1, F2, S1, S2, X1, X2, R12, L12) & - bind(c, name = "mesont_lib_TubeStretchingForceField") - real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor - real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes - real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in) :: L12 ! Equilubrium length of segment (X1,X2) - - call TubeStretchingForceField(U1, U2, F1, F2, S1, S2, X1, X2, R12, L12) - endsubroutine - - subroutine TubeBendingForceField_(U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2) & - bind(c, name = "mesont_lib_TubeBendingForceField") - real(c_double), intent(inout) :: U1, U2, U3 ! Interaction energies associated with nodes X1, X2, and X3 - real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3 ! Forces exerted on nodes X1, X2, and X3 - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3 ! Contributions of nodes X1, X2, and X3 to the virial stress tensor - real(c_double), intent(in), dimension(0:2) :: X1, X2, X3 ! Coordinates of nodes - real(c_double), intent(in) :: R123 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in) :: L123 ! Equilubrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments) - integer(c_int), intent(inout) :: BBF2 - - call TubeBendingForceField(U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2 ) - endsubroutine - - subroutine SegmentTubeForceField_(U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType) & - bind(c, name = "mesont_lib_SegmentTubeForceField") - integer(c_int), intent(in) :: N ! Number of nodes in array X - real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), intent(inout), dimension(0:N-1) :: U ! Interaction energies associated with nodes X - real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2,0:N-1) :: F ! Forces exerted on nodes X - real(c_double), intent(inout), dimension(0:2) :: Fe ! Force exerted on node Xe (can be updated only if Ee > 0) - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor - real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S ! Contributions of nodes X to the virial stress tensor - real(c_double), intent(inout), dimension(0:2,0:2) :: Se ! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0) - real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes - real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in), dimension(0:2,0:N-1) :: X ! Coordinates of the nanotube nodes - real(c_double), intent(in), dimension(0:2) :: Xe ! Additional node of the extended chain if Ee > 0 - integer(c_int), intent(in), dimension(0:N-1) :: BBF ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i) - real(c_double), intent(in) :: R ! Radius of nanotube X - integer(c_int), intent(in) :: E1, E2 ! E1 = 1 if the chnane node 0 is a CNT end; E2 = 1 if the chnane node N-1 is a CNT end; - integer(c_int), intent(in) :: Ee ! Parameter defining the type of the extended chain (0,1,2) - integer(c_int), intent(in) :: TPMType ! Type of the tubular potential (0 or 1) - - call SegmentTubeForceField(U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType) - endsubroutine -endmodule ExportCNT !************************************************************************** diff --git a/tools/mesont/Makefile.gfortran b/tools/mesont/Makefile.gfortran deleted file mode 100644 index 1d95965148..0000000000 --- a/tools/mesont/Makefile.gfortran +++ /dev/null @@ -1,56 +0,0 @@ -SHELL = /bin/sh - -# which file will be copied to Makefile.lammps - -EXTRAMAKE = Makefile.lammps.gfortran - -# ------ FILES ------ - -SRC = LinFun2.f90 Spline1.f90 Spline2.f90 TPMLib.f90 TPMGeom.f90 TubePotBase.f90 TubePotTrue.f90 \ - TubePotMono.f90 TPMM0.f90 TPMM1.f90 CNTPot.f90 TPMForceField.f90 ExportCNT.f90 - -FILES = $(SRC) Makefile - -# ------ DEFINITIONS ------ - -LIB = libmesont.a -OBJ = $(SRC:.f90=.o) - -# ------ SETTINGS ------ - -F90 = gfortran -CC = gcc -F90FLAGS = -O3 -fPIC -ffast-math -ftree-vectorize -fexpensive-optimizations -fno-second-underscore -g -ffree-line-length-none -cpp -#F90FLAGS = -O -ARCHIVE = ar -ARCHFLAG = -rc -LINK = g++ -LINKFLAGS = -O -USRLIB = -SYSLIB = - -# ------ MAKE PROCEDURE ------ - -lib: $(OBJ) - $(ARCHIVE) $(ARFLAGS) $(LIB) $(OBJ) - @cp $(EXTRAMAKE) Makefile.lammps - -# ------ COMPILE RULES ------ - -%.o:%.F - $(F90) $(F90FLAGS) -c $< - -%.o:%.f90 - $(F90) $(F90FLAGS) -c $< - -%.o:%.c - $(CC) $(F90FLAGS) -c $< - -#include .depend -# ------ CLEAN ------ - -clean: - -rm *.o *.mod $(LIB) - -tar: - -tar -cvf ../MESONT.tar $(FILES) \ No newline at end of file diff --git a/tools/mesont/Makefile.ifort b/tools/mesont/Makefile.ifort deleted file mode 100644 index 9c681ac67d..0000000000 --- a/tools/mesont/Makefile.ifort +++ /dev/null @@ -1,52 +0,0 @@ -SHELL = /bin/sh - -# which file will be copied to Makefile.lammps - -EXTRAMAKE = Makefile.lammps.ifort - -# ------ FILES ------ - -SRC = LinFun2.f90 Spline1.f90 Spline2.f90 TPMLib.f90 TPMGeom.f90 TubePotBase.f90 TubePotTrue.f90 \ - TubePotMono.f90 TPMM0.f90 TPMM1.f90 CNTPot.f90 TPMForceField.f90 ExportCNT.f90 - -FILES = $(SRC) Makefile - -# ------ DEFINITIONS ------ - -LIB = libmesont.a -OBJ = $(SRC:.f90=.o) - -# ------ SETTINGS ------ - -F90 = ifort -F90FLAGS = -Ofast -fPIC -ipo -fpp -ARCHIVE = ar -ARCHFLAG = -rc -USRLIB = -SYSLIB = - -# ------ MAKE PROCEDURE ------ - -lib: $(OBJ) - $(ARCHIVE) $(ARFLAGS) $(LIB) $(OBJ) - @cp $(EXTRAMAKE) Makefile.lammps - -# ------ COMPILE RULES ------ - -%.o:%.F - $(F90) $(F90FLAGS) -c $< - -%.o:%.f90 - $(F90) $(F90FLAGS) -c $< - -%.o:%.c - $(CC) $(F90FLAGS) -c $< - -#include .depend -# ------ CLEAN ------ - -clean: - -rm *.o *.mod $(LIB) - -tar: - -tar -cvf ../MESONT.tar $(FILES) diff --git a/tools/mesont/Makefile.lammps b/tools/mesont/Makefile.lammps deleted file mode 100644 index 5e0ea2f5d8..0000000000 --- a/tools/mesont/Makefile.lammps +++ /dev/null @@ -1,5 +0,0 @@ -# Settings that the LAMMPS build will import when this package library is used - -mesont_SYSINC = -mesont_SYSLIB = -lgfortran -mesont_SYSPATH = diff --git a/tools/mesont/Makefile.lammps.gfortran b/tools/mesont/Makefile.lammps.gfortran deleted file mode 100644 index 5e0ea2f5d8..0000000000 --- a/tools/mesont/Makefile.lammps.gfortran +++ /dev/null @@ -1,5 +0,0 @@ -# Settings that the LAMMPS build will import when this package library is used - -mesont_SYSINC = -mesont_SYSLIB = -lgfortran -mesont_SYSPATH = diff --git a/tools/mesont/Makefile.lammps.ifort b/tools/mesont/Makefile.lammps.ifort deleted file mode 100644 index e2ae373f07..0000000000 --- a/tools/mesont/Makefile.lammps.ifort +++ /dev/null @@ -1,5 +0,0 @@ -# Settings that the LAMMPS build will import when this package library is used - -mesont_SYSINC = -mesont_SYSLIB = -lifcore -lsvml -limf -ldl -lstdc++ -lgfortran -mesont_SYSPATH = -L/opt/intel/fce/10.0.023/lib diff --git a/tools/mesont/Makefile.serial b/tools/mesont/Makefile.serial deleted file mode 100644 index c52fbcb986..0000000000 --- a/tools/mesont/Makefile.serial +++ /dev/null @@ -1 +0,0 @@ -Makefile.gfortran \ No newline at end of file diff --git a/tools/mesont/README b/tools/mesont/README index 886263ddb3..9a5289a449 100644 --- a/tools/mesont/README +++ b/tools/mesont/README @@ -1,67 +1,58 @@ -USER-MESONT is a LAMMPS package for simulation of nanomechanics of carbon -nanotubes (CNTs). The model is based on a coarse-grained representation -of CNTs as "flexible cylinders" consisting of a variable number of -segments. Internal interactions within a CNT and the van der Waals -interaction between the tubes are described by a mesoscopic force -field designed and parameterized based on the results of atomic-level -molecular dynamics simulations. The description of the force field -is provided in the papers listed below. +=== USER-MESONT tools === +=============================== -This folder contains a Fortran library implementing basic level functions -describing stretching, bending, and intertube components of the CNT tubular -potential model (TPM) mesoscopic force field. +The programs in this folder can be used to analyze the +output of simulations using the CNT mesoscopic force +field (USER-MESONT). -This library was created by Alexey N. Volkov, University of Alabama, -avolkov1@ua.edu. +dump2vtk.cpp converts output written in *.dump format (the +sequence of columns must be "ATOMS id type x y z Es Eb Et +Ek ix iy iz", the same as in the examples at examples\USER\mesont) +into VTK format that can be visualized as a set of tubes in +Paraview (or other packages). The executable takes 3 parameters: +system.init - an input file with information about connections +between cnt nodes, config.dump - LAMMPS output with snapshots, +out - output folder for writing VTK files (must exist). --- +Code TMDPotGen is designed to generate ASCII text files TPMSSTP.xrs +and TPMA.xrs containing tabulated tubular potentials for +single-walled CNTs with a given chirality (m,n). The input +parameters for the code must be provided in the form of an ASCII +text file TMDPotGen.xdt. The output of the code are files TPMSSTP.xrs +and TPMA.xrs. All parameters in the tables are given in metal units. +The generation of the tables takes approximately 4 hours. -References: +Code TMDGen is designed to generate initial samples composed of +straight and dispersed nanotubes of given chirality and length at +a given material density. In the generated samples, nanotubes are +distributed with random positions and orientations. Both periodic +and free boundary conditions are available along each axis of the +system. The input parameters for the code must be provided in form +of an ASCII text file TMDGen.xdt and include the following: + LS0: sample size along z- and y-directions (A) + HS0: sample size along z-direction (A) + DS0: material density (g/cm^3) + BC_X0: Type of boundary conditions along x-direction (0, Free; 1, Periodic) + BC_Y0: Type of boundary conditions along y-direction (0, Free; 1, Periodic) + BC_Z0: Type of boundary conditions along z-direction (0, Free; 1, Periodic) + ChiIndM: First chirality index of nanotubes + ChiIndN: Second chirality index of nanotubes + LT0: Nanotube length (A) + SegType: Parameter that defines how a nanotubes will be divided into + segments(0, NSeg0 will be used; 1, LSeg0 will be used) + NSeg0: Number of segments in every nanotube. Used if SegType = 0. Then + LSeg0 = LT0 / NSeg0 + LSeg0: Length of segments in every nanotube. Used if SegType = 1. Then + NSeg0 = [ LT0 / LSeg0 ] + DeltaT: Minimum gap between nanotube walls in the generated sample (A) + NAmax: Maximum number of attempts to add new nanotube to the sample + GeomPrec: Precision of calculations (dimensionless). +The output of the code is an ASCII text file TMDSample.init written in the +LAMMPS format compatible with cnt atomic style. All parameters in the sample +files generated with TMDGen are given in metal units. -L. V. Zhigilei, C. Wei, and D. Srivastava, Mesoscopic model for dynamic -simulations of carbon nanotubes, Phys. Rev. B 71, 165417, 2005. -A. N. Volkov and L. V. Zhigilei, Structural stability of carbon nanotube -films: The role of bending buckling, ACS Nano 4, 6187-6195, 2010. - -A. N. Volkov, K. R. Simov, and L. V. Zhigilei, Mesoscopic model for simulation -of CNT-based materials, Proceedings of the ASME International Mechanical -Engineering Congress and Exposition (IMECE2008), ASME paper IMECE2008-68021, -2008. - -A. N. Volkov and L. V. Zhigilei, Mesoscopic interaction potential for carbon -nanotubes of arbitrary length and orientation, J. Phys. Chem. C 114, 5513-5531, -2010. - -B. K. Wittmaack, A. H. Banna, A. N. Volkov, L. V. Zhigilei, Mesoscopic -modeling of structural self-organization of carbon nanotubes into vertically -aligned networks of nanotube bundles, Carbon 130, 69-86, 2018. - -B. K. Wittmaack, A. N. Volkov, L. V. Zhigilei, Mesoscopic modeling of the -uniaxial compression and recovery of vertically aligned carbon nanotube -forests, Compos. Sci. Technol. 166, 66-85, 2018. - -B. K. Wittmaack, A. N. Volkov, L. V. Zhigilei, Phase transformation as the -mechanism of mechanical deformation of vertically aligned carbon nanotube -arrays: Insights from mesoscopic modeling, Carbon 143, 587-597, 2019. - -A. N. Volkov and L. V. Zhigilei, Scaling laws and mesoscopic modeling of -thermal conductivity in carbon nanotube materials, Phys. Rev. Lett. 104, -215902, 2010. - -A. N. Volkov, T. Shiga, D. Nicholson, J. Shiomi, and L. V. Zhigilei, Effect -of bending buckling of carbon nanotubes on thermal conductivity of carbon -nanotube materials, J. Appl. Phys. 111, 053501, 2012. - -A. N. Volkov and L. V. Zhigilei, Heat conduction in carbon nanotube materials: -Strong effect of intrinsic thermal conductivity of carbon nanotubes, Appl. -Phys. Lett. 101, 043113, 2012. - -W. M. Jacobs, D. A. Nicholson, H. Zemer, A. N. Volkov, and L. V. Zhigilei, -Acoustic energy dissipation and thermalization in carbon nanotubes: Atomistic -modeling and mesoscopic description, Phys. Rev. B 86, 165414, 2012. - -A. N. Volkov and A. H. Banna, Mesoscopic computational model of covalent -cross-links and mechanisms of load transfer in cross-linked carbon nanotube -films with continuous networks of bundles, Comp. Mater. Sci. 176, 109410, 2020. +This packages were created by Maxim Shugaev (mvs9t@virginia.edu) +at the University of Virginia and by Alexey N. Volkov (avolkov1@ua.edu) +at the University of Alabama. diff --git a/tools/mesont/TMDGen/Makefile b/tools/mesont/TMDGen/Makefile new file mode 100644 index 0000000000..de6e548c05 --- /dev/null +++ b/tools/mesont/TMDGen/Makefile @@ -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 + diff --git a/tools/mesont/TMDGen/TMDGen.f90 b/tools/mesont/TMDGen/TMDGen.f90 new file mode 100644 index 0000000000..9e927b8b39 --- /dev/null +++ b/tools/mesont/TMDGen/TMDGen.f90 @@ -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 !******************************************************************************** diff --git a/tools/mesont/TMDGen/TMDGen.xdt b/tools/mesont/TMDGen/TMDGen.xdt new file mode 100644 index 0000000000..cf4f3ab5a2 --- /dev/null +++ b/tools/mesont/TMDGen/TMDGen.xdt @@ -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 diff --git a/tools/mesont/TMDGen/TMDGen3D.f90 b/tools/mesont/TMDGen/TMDGen3D.f90 new file mode 100644 index 0000000000..7b0d532c52 --- /dev/null +++ b/tools/mesont/TMDGen/TMDGen3D.f90 @@ -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 !******************************************************************************* diff --git a/tools/mesont/TMDGen/TMDGenData.f90 b/tools/mesont/TMDGen/TMDGenData.f90 new file mode 100644 index 0000000000..65861612e6 --- /dev/null +++ b/tools/mesont/TMDGen/TMDGenData.f90 @@ -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 !***************************************************************************** diff --git a/tools/mesont/TMDGen/TMDSample.in b/tools/mesont/TMDGen/TMDSample.in new file mode 100644 index 0000000000..5c7c79bb7f --- /dev/null +++ b/tools/mesont/TMDGen/TMDSample.in @@ -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 diff --git a/tools/mesont/TPMGeom.f90 b/tools/mesont/TMDGen/TPMGeom.f90 similarity index 72% rename from tools/mesont/TPMGeom.f90 rename to tools/mesont/TMDGen/TPMGeom.f90 index 3925bb47cd..10e68591d0 100644 --- a/tools/mesont/TPMGeom.f90 +++ b/tools/mesont/TMDGen/TPMGeom.f90 @@ -1,57 +1,42 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - module TPMGeom !************************************************************************************ ! -! TMD Library: Geometry functions +! Geometry functions for TPM force field ! !--------------------------------------------------------------------------------------------------- ! ! Intel Fortran ! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017 +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00 ! !*************************************************************************************************** use TPMLib -use iso_c_binding, only : c_int, c_double, c_char + implicit none !--------------------------------------------------------------------------------------------------- ! Constants !--------------------------------------------------------------------------------------------------- - integer(c_int), parameter :: MD_LINES_NONPAR = 0 - integer(c_int), parameter :: MD_LINES_PAR = 1 + integer*4, parameter :: MD_LINES_NONPAR = 0 + integer*4, parameter :: MD_LINES_PAR = 1 !--------------------------------------------------------------------------------------------------- ! Global variables !--------------------------------------------------------------------------------------------------- ! Coordinates of the whole domain - real(c_double) :: DomXmin, DomXmax, DomYmin, DomYmax, DomZmin, DomZmax - real(c_double) :: DomLX, DomLY, DomLZ - real(c_double) :: DomLXhalf, DomLYhalf, DomLZhalf + real*8 :: DomXmin, DomXmax, DomYmin, DomYmax, DomZmin, DomZmax + real*8 :: DomLX, DomLY, DomLZ + real*8 :: DomLXhalf, DomLYhalf, DomLZhalf ! Boundary conditions - integer(c_int) :: BC_X = 0 - integer(c_int) :: BC_Y = 0 - integer(c_int) :: BC_Z = 0 + integer*4 :: BC_X = 0 + integer*4 :: BC_Y = 0 + integer*4 :: BC_Z = 0 ! Skin parameter in NBL and related algorithms - real(c_double) :: Rskin = 1.0d+00 + real*8 :: Rskin = 1.0d+00 contains !****************************************************************************************** @@ -59,7 +44,7 @@ contains !********************************************************************** ! This subroutine changes coortinates of the point accorning to periodic boundary conditions ! it order to makesure that the point is inside the computational cell !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2), intent(inout) :: R + real*8, dimension(0:2), intent(inout) :: R !------------------------------------------------------------------------------------------- ! These commented lines implemment the more general, but less efficient algorithm !if ( BC_X == 1 ) R(0) = R(0) - DomLX * roundint ( R(0) / DomLX ) @@ -92,9 +77,9 @@ contains !********************************************************************** ! This function calculates the point Q of projection of point R0 on line (R1,L1) ! Q = R1 + Disaplacement * L1 !------------------------------------------------------------------------------------------- - real(c_double), intent(inout) :: Displacement - real(c_double), dimension(0:2), intent(inout) :: Q - real(c_double), dimension(0:2), intent(in) :: R1, L1, R0 + real*8, intent(inout) :: Displacement + real*8, dimension(0:2), intent(inout) :: Q + real*8, dimension(0:2), intent(in) :: R1, L1, R0 !-------------------------------------------------------------------------------------------- Q = R0 - R1 ! Here we take into account periodic boundaries @@ -103,7 +88,7 @@ contains !********************************************************************** Q = R1 + Displacement * L1 end subroutine LinePoint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!!!!!!! + integer*4 function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!!!!!!! ! This function determines the neares distance H between two lines (R1,L1) and (R2,L2) !------------------------------------------------------------------------------------------- ! Input values: @@ -116,13 +101,13 @@ contains !********************************************************************** ! D1, D2, displacemets ! L12, unit vector directed along the closes distance !------------------------------------------------------------------------------------------- - real(c_double), intent(inout) :: H, cosA, D1, D2 - real(c_double), dimension(0:2), intent(out) :: L12 - real(c_double), dimension(0:2), intent(in) :: R1, L1, R2, L2 + real*8, intent(inout) :: H, cosA, D1, D2 + real*8, dimension(0:2), intent(out) :: L12 + real*8, dimension(0:2), intent(in) :: R1, L1, R2, L2 !------------------------------------------------------------------------------------------- - real(c_double), intent(in) :: Prec - real(c_double), dimension(0:2) :: Q1, Q2, R - real(c_double) :: C, DD1, DD2, C1, C2 + real*8, intent(in) :: Prec + real*8, dimension(0:2) :: Q1, Q2, R + real*8 :: C, DD1, DD2, C1, C2 !------------------------------------------------------------------------------------------- cosA = S_V3xV3 ( L1, L2 ) C = 1.0 - sqr ( cosA ) diff --git a/tools/mesont/TMDGen/TPMLib.f90 b/tools/mesont/TMDGen/TPMLib.f90 new file mode 100644 index 0000000000..9509594046 --- /dev/null +++ b/tools/mesont/TMDGen/TPMLib.f90 @@ -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 !********************************************************************************* + diff --git a/tools/mesont/LinFun2.f90 b/tools/mesont/TMDPotGen/LinFun2.f90 similarity index 50% rename from tools/mesont/LinFun2.f90 rename to tools/mesont/TMDPotGen/LinFun2.f90 index f6aa9bf75d..409c4d4baf 100644 --- a/tools/mesont/LinFun2.f90 +++ b/tools/mesont/TMDPotGen/LinFun2.f90 @@ -1,21 +1,6 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - module LinFun2 !************************************************************************************ ! -! TMD Library: Bi-linear functions and their derivatives +! Bi-linear functions and their derivatives. ! !--------------------------------------------------------------------------------------------------- ! @@ -24,18 +9,18 @@ module LinFun2 !**************************************************************** ! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017 ! !*************************************************************************************************** -use iso_c_binding, only : c_int, c_double, c_char + implicit none contains !****************************************************************************************** - real(c_double) function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int), intent(in) :: i, N - real(c_double), intent(in) :: X - real(c_double), dimension(0:N-1), intent(in) :: P - real(c_double), dimension(0:N-1), intent(inout) :: F - integer(c_int) :: i1 - real(c_double) :: A, A0 + real*8 function CalcLinFun1_0 ( i, X, N, P, F ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4, intent(in) :: i, N + real*8, intent(in) :: X + real*8, dimension(0:N-1), intent(in) :: P + real*8, dimension(0:N-1), intent(inout) :: F + integer*4 :: i1 + real*8 :: A, A0 !------------------------------------------------------------------------------------------- i1 = i - 1 A0 = ( P(i) - X ) / ( P(i) - P(i1) ) @@ -44,13 +29,13 @@ contains !********************************************************************** end function CalcLinFun1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CalcLinFun1_1 ( S, Sx1, i, X, N, P, F, Fx ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: S, Sx1 - integer(c_int), intent(in) :: i, N - real(c_double), intent(in) :: X - real(c_double), dimension(0:N-1), intent(in) :: P - real(c_double), dimension(0:N-1), intent(inout) :: F, Fx - integer(c_int) :: i1 - real(c_double) :: A, A0 + real*8, intent(out) :: S, Sx1 + integer*4, intent(in) :: i, N + real*8, intent(in) :: X + real*8, dimension(0:N-1), intent(in) :: P + real*8, dimension(0:N-1), intent(inout) :: F, Fx + integer*4 :: i1 + real*8 :: A, A0 !------------------------------------------------------------------------------------------- i1 = i - 1 A0 = ( P(i) - X ) / ( P(i) - P(i1) ) @@ -59,14 +44,14 @@ contains !********************************************************************** Sx1 = A0 * Fx(i1) + A * Fx(i) end subroutine CalcLinFun1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function CalcLinFun2_0 ( i, j, X, Y, N1, N2, P1, P2, F ) !! - integer(c_int), intent(in) :: i, j, N1, N2 - real(c_double), intent(in) :: X, Y - real(c_double), dimension(0:N1-1), intent(in) :: P1 - real(c_double), dimension(0:N2-1), intent(in) :: P2 - real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F - integer(c_int) :: i1, j1 - real(c_double) :: A, A0, B, B0, G, G0 + real*8 function CalcLinFun2_0 ( i, j, X, Y, N1, N2, P1, P2, F ) !! + integer*4, intent(in) :: i, j, N1, N2 + real*8, intent(in) :: X, Y + real*8, dimension(0:N1-1), intent(in) :: P1 + real*8, dimension(0:N2-1), intent(in) :: P2 + real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F + integer*4 :: i1, j1 + real*8 :: A, A0, B, B0, G, G0 !------------------------------------------------------------------------------------------- i1 = i - 1 j1 = j - 1 @@ -80,14 +65,14 @@ contains !********************************************************************** end function CalcLinFun2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CalcLinFun2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fx, Fy ) !!!!!!!!!!!! - real(c_double), intent(out) :: S, Sx1, Sy1 - integer(c_int), intent(in) :: i, j, N1, N2 - real(c_double), intent(in) :: X, Y - real(c_double), dimension(0:N1-1), intent(in) :: P1 - real(c_double), dimension(0:N2-1), intent(in) :: P2 - real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fx, Fy - integer(c_int) :: i1, j1 - real(c_double) :: A, A0, B, B0, G, G0 + real*8, intent(out) :: S, Sx1, Sy1 + integer*4, intent(in) :: i, j, N1, N2 + real*8, intent(in) :: X, Y + real*8, dimension(0:N1-1), intent(in) :: P1 + real*8, dimension(0:N2-1), intent(in) :: P2 + real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fx, Fy + integer*4 :: i1, j1 + real*8 :: A, A0, B, B0, G, G0 !------------------------------------------------------------------------------------------- i1 = i - 1 j1 = j - 1 diff --git a/tools/mesont/TMDPotGen/Makefile b/tools/mesont/TMDPotGen/Makefile new file mode 100644 index 0000000000..b09fbb05e7 --- /dev/null +++ b/tools/mesont/TMDPotGen/Makefile @@ -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 + diff --git a/tools/mesont/Spline1.f90 b/tools/mesont/TMDPotGen/Spline1.f90 similarity index 65% rename from tools/mesont/Spline1.f90 rename to tools/mesont/TMDPotGen/Spline1.f90 index ae1a51dc77..d2df8d0e8c 100644 --- a/tools/mesont/Spline1.f90 +++ b/tools/mesont/TMDPotGen/Spline1.f90 @@ -1,21 +1,6 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - module Spline1 !************************************************************************************ ! -! TMD Library: One-dimensional cubic spline function +! One-dimensional cubic spline function. ! !--------------------------------------------------------------------------------------------------- ! @@ -24,25 +9,26 @@ module Spline1 !**************************************************************** ! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017 ! !*************************************************************************************************** -use iso_c_binding, only : c_int, c_double, c_char + implicit none contains !****************************************************************************************** - real(c_double) function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 - real(c_double) :: H26, HL, HR + real*8 function ValueSpline1_0 ( X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 + real*8 :: H26, HL, HR !------------------------------------------------------------------------------------------- H26 = Hi_1 * Hi_1 / 6.0 Hl = X - Xi_1 Hr = Xi - X - ValueSpline1_0 = ( ( Mi_1 * Hr * Hr * Hr + Mi * Hl * Hl * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * Hr + ( Yi - Mi * H26 ) * Hl ) / Hi_1 + ValueSpline1_0 = ( ( Mi_1 * Hr * Hr * Hr + Mi * Hl * Hl * Hl ) / 6.0 + ( Yi_1 - Mi_1 * H26 ) * Hr & + + ( Yi - Mi * H26 ) * Hl ) / Hi_1 end function ValueSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine ValueSpline1_1 ( S, S1, X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 ) !!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: S, S1 - real(c_double), intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 - real(c_double) :: H6, H26, HL, HR, HL2, HR2 + real*8, intent(out) :: S, S1 + real*8, intent(in) :: X, Xi, Xi_1, Yi, Yi_1, Mi, Mi_1, Hi_1 + real*8 :: H6, H26, HL, HR, HL2, HR2 !------------------------------------------------------------------------------------------- H6 = Hi_1 / 6.0d+00 H26 = Hi_1 * H6 @@ -55,14 +41,11 @@ contains !********************************************************************** end subroutine ValueSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine sprogonka3 ( N, K0, K1, K2, F, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! K0[i] * X[i-1] + K1[i] * X[I] + K2[i] * X[i+1] = F[i] - ! i = 0..(N-1) - !------------------------------------------------------------------------------------------- - integer(c_int), intent(in) :: N - real(c_double), dimension(0:N-1), intent(in) :: K0, K1, K2 - real(c_double), dimension(0:N-1), intent(inout) :: F, X - real(c_double) :: D - integer(c_int) :: i + integer*4, intent(in) :: N + real*8, dimension(0:N-1), intent(in) :: K0, K1, K2 + real*8, dimension(0:N-1), intent(inout) :: F, X + real*8 :: D + integer*4 :: i !------------------------------------------------------------------------------------------- X(0) = F(0) / K1(0) F(0) = - K2(0) / K1(0) @@ -77,11 +60,11 @@ contains !********************************************************************** end subroutine sprogonka3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CreateSpline1 ( CL, CR, N, P, F, M, D, K0, K1, K2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int), intent(in) :: CL, CR, N - real(c_double), dimension (0:N-1), intent(in) :: P, F - real(c_double), dimension (0:N-1), intent(inout):: M, D, K0, K1, K2 - integer(c_int) :: i - real(c_double) :: Z + integer*4, intent(in) :: CL, CR, N + real*8, dimension (0:N-1), intent(in) :: P, F + real*8, dimension (0:N-1), intent(inout):: M, D, K0, K1, K2 + integer*4 :: i + real*8 :: Z !------------------------------------------------------------------------------------------- do i = 1, N - 1 K0(i) = P(i) - P(i-1) @@ -124,12 +107,12 @@ contains !********************************************************************** call sprogonka3 ( N, K0, K1, K2, D, M ) end subroutine CreateSpline1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int), intent(in) :: i, N - real(c_double), intent(in) :: X - real(c_double), dimension(0:N-1), intent(in) :: P, F, M - integer(c_int) :: j - real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH + real*8 function CalcSpline1_0 ( i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4, intent(in) :: i, N + real*8, intent(in) :: X + real*8, dimension(0:N-1), intent(in) :: P, F, M + integer*4 :: j + real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH !------------------------------------------------------------------------------------------- j = i - 1 HL = X - P(j) @@ -141,16 +124,17 @@ contains !********************************************************************** HR2 = HR * HR HLH = HL / H HRH = HR / H - CalcSpline1_0 = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH + ( F(i) - M(i) * H26 ) * HLH + CalcSpline1_0 = ( M(j) * HR2 * HRH + M(i) * HL2 * HLH ) / 6.0d+00 + ( F(j) - M(j) * H26 ) * HRH & + + ( F(i) - M(i) * H26 ) * HLH end function CalcSpline1_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CalcSpline1_1 ( S, S1, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: S, S1 - integer(c_int), intent(in) :: i, N - real(c_double), intent(in) :: X - real(c_double), dimension(0:N-1), intent(in) :: P, F, M - integer(c_int) :: j - real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH + real*8, intent(out) :: S, S1 + integer*4, intent(in) :: i, N + real*8, intent(in) :: X + real*8, dimension(0:N-1), intent(in) :: P, F, M + integer*4 :: j + real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH !------------------------------------------------------------------------------------------- j = i - 1 HL = X - P(j) @@ -167,12 +151,12 @@ contains !********************************************************************** end subroutine CalcSpline1_1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CalcSpline1_2 ( S, S1, S2, i, X, N, P, F, M ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: S, S1, S2 - integer(c_int), intent(in) :: i, N - real(c_double), intent(in) :: X - real(c_double), dimension(0:N-1), intent(in) :: P, F, M - integer(c_int) :: j - real(c_double) :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH + real*8, intent(out) :: S, S1, S2 + integer*4, intent(in) :: i, N + real*8, intent(in) :: X + real*8, dimension(0:N-1), intent(in) :: P, F, M + integer*4 :: j + real*8 :: HL, HR, H, H6, H26, HR2, HL2, HRH, HLH !------------------------------------------------------------------------------------------- j = i - 1 HL = X - P(j) @@ -190,3 +174,4 @@ contains !********************************************************************** end subroutine CalcSpline1_2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module Spline1 !******************************************************************************** + \ No newline at end of file diff --git a/tools/mesont/Spline2.f90 b/tools/mesont/TMDPotGen/Spline2.f90 similarity index 70% rename from tools/mesont/Spline2.f90 rename to tools/mesont/TMDPotGen/Spline2.f90 index 720d73f553..8b3239991a 100644 --- a/tools/mesont/Spline2.f90 +++ b/tools/mesont/TMDPotGen/Spline2.f90 @@ -1,21 +1,6 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - module Spline2 !************************************************************************************ ! -! TMD Library: Two-dimensional cubic spline function +! Two-dimensional cubic spline function. ! !--------------------------------------------------------------------------------------------------- ! @@ -26,18 +11,18 @@ module Spline2 !**************************************************************** !*************************************************************************************************** use Spline1 -use iso_c_binding, only : c_int, c_double, c_char + implicit none contains !****************************************************************************************** subroutine CreateSpline2 ( CL, CD, CR, CU, N1, N2, N, P1, P2, F, Fxx, Fyy, Fxxyy, FF, MM, DD, K0, K1, K2 ) - integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N2, N - real(c_double), dimension(0:N1-1), intent(in) :: P1 - real(c_double), dimension(0:N2-1), intent(in) :: P2 - real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy - real(c_double), dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2 - integer(c_int) :: II + integer*4, intent(in) :: CL, CD, CR, CU, N1, N2, N + real*8, dimension(0:N1-1), intent(in) :: P1 + real*8, dimension(0:N2-1), intent(in) :: P2 + real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy + real*8, dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2 + integer*4 :: II !------------------------------------------------------------------------------------------- do II = 0, N2 - 1 FF(0:N1-1) = F(0:N1-1,II) @@ -69,12 +54,12 @@ contains !********************************************************************** end subroutine CreateSpline2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CreateSpline2Ext ( CL, CD, CR, CU, N1, N1A, N2, N2A, N, P1, P2, F, Fxx, Fyy, Fxxyy, FF, MM, DD, K0, K1, K2 ) - integer(c_int), intent(in) :: CL, CD, CR, CU, N1, N1A, N2, N2A, N - real(c_double), dimension(0:N1-1), intent(in) :: P1 - real(c_double), dimension(0:N2-1), intent(in) :: P2 - real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy - real(c_double), dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2 - integer(c_int) :: II + integer*4, intent(in) :: CL, CD, CR, CU, N1, N1A, N2, N2A, N + real*8, dimension(0:N1-1), intent(in) :: P1 + real*8, dimension(0:N2-1), intent(in) :: P2 + real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy + real*8, dimension(0:N-1), intent(inout) :: FF, MM, DD, K0, K1, K2 + integer*4 :: II !------------------------------------------------------------------------------------------- Fxx = 0.0d+00 Fyy = 0.0d+00 @@ -142,14 +127,14 @@ contains !********************************************************************** end subroutine CreateSpline2Ext !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function CalcSpline2_0 ( i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!!!!!!!!! - integer(c_int), intent(in) :: i, j, N1, N2 - real(c_double), intent(in) :: X, Y - real(c_double), dimension(0:N1-1), intent(in) :: P1 - real(c_double), dimension(0:N2-1), intent(in) :: P2 - real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy - integer(c_int) :: i1, j1 - real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1 + real*8 function CalcSpline2_0 ( i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!!!!!!!!!! + integer*4, intent(in) :: i, j, N1, N2 + real*8, intent(in) :: X, Y + real*8, dimension(0:N1-1), intent(in) :: P1 + real*8, dimension(0:N2-1), intent(in) :: P2 + real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy + integer*4 :: i1, j1 + real*8 :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1 !------------------------------------------------------------------------------------------- i1 = i - 1 j1 = j - 1 @@ -162,15 +147,15 @@ contains !********************************************************************** end function CalcSpline2_0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CalcSpline2_1 ( S, Sx1, Sy1, i, j, X, Y, N1, N2, P1, P2, F, Fxx, Fyy, Fxxyy ) !!! - real(c_double), intent(out) :: S, Sx1, Sy1 - integer(c_int), intent(in) :: i, j, N1, N2 - real(c_double), intent(in) :: X, Y - real(c_double), dimension(0:N1-1), intent(in) :: P1 - real(c_double), dimension(0:N2-1), intent(in) :: P2 - real(c_double), dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy - integer(c_int) :: i1, j1 - real(c_double) :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1 - real(c_double) :: Gyy_0, Gyy_1, Gxxyy_0, Gxxyy_1 + real*8, intent(out) :: S, Sx1, Sy1 + integer*4, intent(in) :: i, j, N1, N2 + real*8, intent(in) :: X, Y + real*8, dimension(0:N1-1), intent(in) :: P1 + real*8, dimension(0:N2-1), intent(in) :: P2 + real*8, dimension(0:N1-1,0:N2-1), intent(inout) :: F, Fxx, Fyy, Fxxyy + integer*4 :: i1, j1 + real*8 :: T, Gy_0, Gy_1, Gxxy_0, Gxxy_1 + real*8 :: Gyy_0, Gyy_1, Gxxyy_0, Gxxyy_1 !------------------------------------------------------------------------------------------- i1 = i - 1 j1 = j - 1 diff --git a/tools/mesont/TMDPotGen/TMDPotGen.f90 b/tools/mesont/TMDPotGen/TMDPotGen.f90 new file mode 100644 index 0000000000..f4eabdd0ba --- /dev/null +++ b/tools/mesont/TMDPotGen/TMDPotGen.f90 @@ -0,0 +1,62 @@ +program TMDPotGen !********************************************************************************* +! +! Stand-alone generator of files containing tubular potential data for single-walled CNTs. +! +!--------------------------------------------------------------------------------------------------- +! +! Intel Fortran +! +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020 +! +!*************************************************************************************************** + +use TubePotMono + +implicit none + +!--------------------------------------------------------------------------------------------------- +! Global variables +!--------------------------------------------------------------------------------------------------- + + integer*4 :: ChiIndM = 10 ! Chirality index m of nanotubes + integer*4 :: ChiIndN = 10 ! Chirality index n of nanotubes + +!--------------------------------------------------------------------------------------------------- +! Body +!--------------------------------------------------------------------------------------------------- + + TPMStartMode = 0 + + ! Reading and printing of governing parameters + call LoadGoverningParameters () + call PrintGoverningParameters () + + call TPBInit () + call TPMInit ( ChiIndM, ChiIndN ) + +contains !------------------------------------------------------------------------------------------ + + subroutine LoadGoverningParameters () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This function reads governing parameters from xdt file + !------------------------------------------------------------------------------------------- + integer*4 :: Fuid, i + character*512 :: Msg + !------------------------------------------------------------------------------------------- + Fuid = OpenFile ( 'TMDPotGen.xdt', 'rt', '' ) + read ( unit = Fuid, fmt = '(i22)' ) ChiIndM + read ( unit = Fuid, fmt = '(i22)' ) ChiIndN + call CloseFile ( Fuid ) + end subroutine LoadGoverningParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine PrintGoverningParameters () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This function prints governing parameters to xlg file + !------------------------------------------------------------------------------------------- + integer*4 :: Fuid, i + !------------------------------------------------------------------------------------------- + Fuid = OpenFile ( 'TMDPotGen.xlg', 'wt', '' ) + write ( unit = Fuid, fmt = '(i22,a)' ) ChiIndM, ' : ChiIndM' + write ( unit = Fuid, fmt = '(i22,a)' ) ChiIndN, ' : ChiIndN' + call CloseFile ( Fuid ) + end subroutine PrintGoverningParameters !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end program TMDPotGen !***************************************************************************** diff --git a/tools/mesont/TMDPotGen/TMDPotGen.xdt b/tools/mesont/TMDPotGen/TMDPotGen.xdt new file mode 100644 index 0000000000..505d2fd3ad --- /dev/null +++ b/tools/mesont/TMDPotGen/TMDPotGen.xdt @@ -0,0 +1,2 @@ + 10 : ChiIndM + 10 : ChiIndN diff --git a/tools/mesont/TMDPotGen/TPMGeom.f90 b/tools/mesont/TMDPotGen/TPMGeom.f90 new file mode 100644 index 0000000000..280de38935 --- /dev/null +++ b/tools/mesont/TMDPotGen/TPMGeom.f90 @@ -0,0 +1,144 @@ +module TPMGeom !************************************************************************************ +! +! Geometry functions for TPM force field. +! +!--------------------------------------------------------------------------------------------------- +! +! Intel Fortran +! +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020 +! +!*************************************************************************************************** + +use TPMLib + +implicit none + +!--------------------------------------------------------------------------------------------------- +! Constants +!--------------------------------------------------------------------------------------------------- + + integer*4, parameter :: MD_LINES_NONPAR = 0 + integer*4, parameter :: MD_LINES_PAR = 1 + +!--------------------------------------------------------------------------------------------------- +! Global variables +!--------------------------------------------------------------------------------------------------- + + ! Coordinates of the whole domain + real*8 :: DomXmin, DomXmax, DomYmin, DomYmax, DomZmin, DomZmax + real*8 :: DomLX, DomLY, DomLZ + real*8 :: DomLXhalf, DomLYhalf, DomLZhalf + + ! Boundary conditions + integer*4 :: BC_X = 0 + integer*4 :: BC_Y = 0 + integer*4 :: BC_Z = 0 + + ! Skin parameter in NBL and related algorithms + real*8 :: Rskin = 1.0d+00 + +contains !****************************************************************************************** + + subroutine ApplyPeriodicBC ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This subroutine changes coordinates of the point according to periodic boundary conditions + ! it order to make sure that the point is inside the computational cell + !------------------------------------------------------------------------------------------- + real*8, dimension(0:2), intent(inout) :: R + !------------------------------------------------------------------------------------------- + ! These commented lines implement the more general, but less efficient algorithm + !if ( BC_X == 1 ) R(0) = R(0) - DomLX * roundint ( R(0) / DomLX ) + !if ( BC_Y == 1 ) R(1) = R(1) - DomLY * roundint ( R(1) / DomLY ) + !if ( BC_Z == 1 ) R(2) = R(2) - DomLZ * roundint ( R(2) / DomLZ ) + if ( BC_X == 1 ) then + if ( R(0) .GT. DomLXHalf ) then + R(0) = R(0) - DomLX + else if ( R(0) .LT. - DomLXHalf ) then + R(0) = R(0) + DomLX + end if + end if + if ( BC_Y == 1 ) then + if ( R(1) .GT. DomLYHalf ) then + R(1) = R(1) - DomLY + else if ( R(1) .LT. - DomLYHalf ) then + R(1) = R(1) + DomLY + end if + end if + if ( BC_Z == 1 ) then + if ( R(2) .GT. DomLZHalf ) then + R(2) = R(2) - DomLZ + else if ( R(2) .LT. - DomLZHalf ) then + R(2) = R(2) + DomLZ + end if + end if + end subroutine ApplyPeriodicBC !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine LinePoint ( Displacement, Q, R1, L1, R0 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This function calculates the point Q of projection of point R0 on line (R1,L1) + ! Q = R1 + Disaplacement * L1 + !------------------------------------------------------------------------------------------- + real*8, intent(inout) :: Displacement + real*8, dimension(0:2), intent(inout) :: Q + real*8, dimension(0:2), intent(in) :: R1, L1, R0 + !-------------------------------------------------------------------------------------------- + Q = R0 - R1 + ! Here we take into account periodic boundaries + call ApplyPeriodicBC ( Q ) + Displacement = S_V3xV3 ( Q, L1 ) + Q = R1 + Displacement * L1 + end subroutine LinePoint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + integer*4 function LineLine ( H, cosA, D1, D2, L12, R1, L1, R2, L2, Prec ) !!!!!!!!!!!!!!!!! + ! This function determines the nearest distance H between two lines (R1,L1) and (R2,L2) + !------------------------------------------------------------------------------------------- + ! Input values: + ! R1, L1, point and direction of line 1 + ! R2, L2, point and direction of line 2 + ! Prec, precision for the case L1 * L2 = 0 (parallel lines) + ! Return values: + ! H, minimal distance between lines + ! cosA, cosine of angle between lines + ! D1, D2, displacements + ! L12, unit vector directed along the closes distance + !------------------------------------------------------------------------------------------- + real*8, intent(inout) :: H, cosA, D1, D2 + real*8, dimension(0:2), intent(out) :: L12 + real*8, dimension(0:2), intent(in) :: R1, L1, R2, L2 + !------------------------------------------------------------------------------------------- + real*8, intent(in) :: Prec + real*8, dimension(0:2) :: Q1, Q2, R + real*8 :: C, DD1, DD2, C1, C2 + !------------------------------------------------------------------------------------------- + cosA = S_V3xV3 ( L1, L2 ) + C = 1.0 - sqr ( cosA ) + if ( C < Prec ) then ! Lines are parallel to each other + LineLine = MD_LINES_PAR + return + end if + LineLine = MD_LINES_NONPAR + R = R2 - R1 + ! Here we take into account periodic boundaries + call ApplyPeriodicBC ( R ) + DD1 = S_V3xV3 ( R, L1 ) + DD2 = S_V3xV3 ( R, L2 ) + D1 = ( cosA * DD2 - DD1 ) / C + D2 = ( DD2 - cosA * DD1 ) / C + Q1 = R1 - D1 * L1 + Q2 = R2 - D2 * L2 + L12 = Q2 - Q1 + ! Here we take into account periodic boundaries + call ApplyPeriodicBC ( L12 ) + H = S_V3norm3 ( L12 ) + if ( H < Prec ) then ! Lines intersect each other + C1 = signum ( D1 ) + C2 = signum ( D1 ) * signum ( cosA ) + Q1 = C1 * L1 + Q2 = C2 * L2 + call V3_V3xxV3 ( L12, Q1, Q2 ) + call V3_ort ( L12 ) + else ! No intersection + L12 = L12 / H + end if + end function LineLine !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module TPMGeom !******************************************************************************** diff --git a/tools/mesont/TPMLib.f90 b/tools/mesont/TMDPotGen/TPMLib.f90 similarity index 68% rename from tools/mesont/TPMLib.f90 rename to tools/mesont/TMDPotGen/TPMLib.f90 index 9e4be87814..fe8e85916d 100644 --- a/tools/mesont/TPMLib.f90 +++ b/tools/mesont/TMDPotGen/TPMLib.f90 @@ -1,60 +1,45 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - module TPMLib !************************************************************************************* ! -! TMD Library: Basic constants, types, and mathematical functions +! Common constants, types, and functions for TPM force field. ! !--------------------------------------------------------------------------------------------------- ! ! Intel Fortran ! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017 +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020 ! !*************************************************************************************************** -use iso_c_binding, only : c_int, c_double, c_char + implicit none !--------------------------------------------------------------------------------------------------- ! Mathematical constants !--------------------------------------------------------------------------------------------------- - real(c_double), parameter :: M_PI_2 = 1.57079632679489661923 - real(c_double), parameter :: M_PI = 3.14159265358979323846 - real(c_double), parameter :: M_3PI_2 = 4.71238898038468985769 - real(c_double), parameter :: M_2PI = 6.28318530717958647692 - real(c_double), parameter :: M_PI_180 = 0.017453292519943295769 + real*8, parameter :: M_PI_2 = 1.57079632679489661923 + real*8, parameter :: M_PI = 3.14159265358979323846 + real*8, parameter :: M_3PI_2 = 4.71238898038468985769 + real*8, parameter :: M_2PI = 6.28318530717958647692 + real*8, parameter :: M_PI_180 = 0.017453292519943295769 !--------------------------------------------------------------------------------------------------- ! Physical unit constants !--------------------------------------------------------------------------------------------------- - real(c_double), parameter :: K_AMU = 1.66056E-27 ! a.m.u. (atomic mass unit, Dalton) - real(c_double), parameter :: K_EV = 1.60217646e-19 ! eV (electron-volt) + real*8, parameter :: K_AMU = 1.66056E-27 ! a.m.u. (atomic mass unit, Dalton) + real*8, parameter :: K_EV = 1.60217646e-19 ! eV (electron-volt) - real(c_double), parameter :: K_MDLU = 1.0E-10 ! MD length unit (m) - real(c_double), parameter :: K_MDEU = K_EV ! MD energy unit (J) - real(c_double), parameter :: K_MDMU = K_AMU ! MD mass unit (kg) - real(c_double), parameter :: K_MDFU = K_MDEU / K_MDLU ! MD force unit (N) - real(c_double), parameter :: K_MDCU = K_MDEU / K_MDMU ! MD specific heat unit (J/(kg*K)) + real*8, parameter :: K_MDLU = 1.0E-10 ! MD length unit (m) + real*8, parameter :: K_MDEU = K_EV ! MD energy unit (J) + real*8, parameter :: K_MDMU = K_AMU ! MD mass unit (kg) + real*8, parameter :: K_MDFU = K_MDEU / K_MDLU ! MD force unit (N) + real*8, parameter :: K_MDCU = K_MDEU / K_MDMU ! MD specific heat unit (J/(kg*K)) !--------------------------------------------------------------------------------------------------- ! Global variables !--------------------------------------------------------------------------------------------------- - integer(c_int) :: StdUID = 31 + integer*4 :: StdUID = 31 contains !****************************************************************************************** @@ -62,20 +47,20 @@ contains !********************************************************************** ! Simple mathematical functions !--------------------------------------------------------------------------------------------------- - real(c_double) function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: X + real*8 function rad ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: X !------------------------------------------------------------------------------------------- rad = X * M_PI_180 end function rad !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: X + real*8 function sqr ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: X !------------------------------------------------------------------------------------------- sqr = X * X end function sqr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: X + integer*4 function signum ( X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: X !------------------------------------------------------------------------------------------- if ( X > 0 ) then signum = 1 @@ -90,20 +75,20 @@ contains !********************************************************************** ! Vector & matrix functions !--------------------------------------------------------------------------------------------------- - real(c_double) function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), dimension(0:2), intent(in) :: V + real*8 function S_V3xx ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, dimension(0:2), intent(in) :: V !------------------------------------------------------------------------------------------- S_V3xx = V(0) * V(0) + V(1) * V(1) + V(2) * V(2) end function S_V3xx !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function S_V3xV3 ( V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), dimension(0:2), intent(in) :: V1, V2 + real*8 function S_V3xV3 ( V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, dimension(0:2), intent(in) :: V1, V2 !------------------------------------------------------------------------------------------- S_V3xV3 = V1(0) * V2(0) + V1(1) * V2(1) + V1(2) * V2(2) end function S_V3xV3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function S_V3norm3 ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), dimension(0:2), intent(in) :: V + real*8 function S_V3norm3 ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, dimension(0:2), intent(in) :: V !------------------------------------------------------------------------------------------- S_V3norm3 = dsqrt ( V(0) * V(0) + V(1) * V(1) + V(2) * V(2) ) end function S_V3norm3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -111,9 +96,9 @@ contains !********************************************************************** subroutine V3_ort ( V ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Vector production !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2), intent(inout) :: V + real*8, dimension(0:2), intent(inout) :: V !------------------------------------------------------------------------------------------- - real(c_double) :: Vabs + real*8 :: Vabs !------------------------------------------------------------------------------------------- Vabs = S_V3norm3 ( V ) V(0) = V(0) / Vabs @@ -124,8 +109,8 @@ contains !********************************************************************** subroutine V3_V3xxV3 ( V, V1, V2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Vector production !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2), intent(out) :: V - real(c_double), dimension(0:2), intent(in) :: V1, V2 + real*8, dimension(0:2), intent(out) :: V + real*8, dimension(0:2), intent(in) :: V1, V2 !------------------------------------------------------------------------------------------- V(0) = V1(1) * V2(2) - V1(2) * V2(1) V(1) = V1(2) * V2(0) - V1(0) * V2(2) @@ -139,10 +124,10 @@ contains !********************************************************************** subroutine RotationMatrix3 ( M, Psi, Tet, Phi ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Ksi, Tet and Phi are Euler angles !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2,0:2), intent(out) :: M - real(c_double), intent(in) :: Psi, Tet, Phi + real*8, dimension(0:2,0:2), intent(out) :: M + real*8, intent(in) :: Psi, Tet, Phi !------------------------------------------------------------------------------------------- - real(c_double) :: cK, sK, cT, sT, cP, sP + real*8 :: cK, sK, cT, sT, cP, sP !------------------------------------------------------------------------------------------- cK = dcos ( Psi ) sK = dsin ( Psi ) @@ -162,8 +147,8 @@ contains !********************************************************************** end subroutine RotationMatrix3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine EulerAngles ( Psi, Tet, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: Tet, Psi - real(c_double), dimension(0:2), intent(in) :: L + real*8, intent(out) :: Tet, Psi + real*8, dimension(0:2), intent(in) :: L !------------------------------------------------------------------------------------------- Tet = acos ( L(2) ) Psi = atan2 ( L(1), L(0) ) @@ -175,13 +160,13 @@ contains !********************************************************************** end subroutine EulerAngles !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! File inout and output +! File input and output !--------------------------------------------------------------------------------------------------- - integer(c_int) function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function OpenFile ( Name, Params, Path ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! character*(*), intent(in) :: Name, Params, Path !------------------------------------------------------------------------------------------- - integer(c_int) :: Fuid + integer*4 :: Fuid character*512 :: FullName, Msg, Name1, Action1, Status1, Form1, Position1 !------------------------------------------------------------------------------------------- OpenFile = StdUID + 1 @@ -209,7 +194,7 @@ contains !********************************************************************** end function OpenFile !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine CloseFile ( Fuid ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int), intent(inout) :: Fuid + integer*4, intent(inout) :: Fuid !------------------------------------------------------------------------------------------- if ( Fuid < 0 ) return close ( unit = Fuid ) @@ -217,3 +202,4 @@ contains !********************************************************************** end subroutine CloseFile !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module TPMLib !********************************************************************************* + diff --git a/tools/mesont/TubePotBase.f90 b/tools/mesont/TMDPotGen/TubePotBase.f90 similarity index 55% rename from tools/mesont/TubePotBase.f90 rename to tools/mesont/TMDPotGen/TubePotBase.f90 index 1863c36b91..7990849b0c 100644 --- a/tools/mesont/TubePotBase.f90 +++ b/tools/mesont/TMDPotGen/TubePotBase.f90 @@ -1,28 +1,12 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - module TubePotBase !******************************************************************************** ! -! TMD Library: Non-Bonded pair interaction potential and transfer functions for atoms composing -! nanotubes. +! Non-Bonded pair interaction potential and transfer functions for atoms composing nanotubes. ! !--------------------------------------------------------------------------------------------------- ! ! Intel Fortran ! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017 +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020 ! !--------------------------------------------------------------------------------------------------- ! @@ -30,15 +14,15 @@ module TubePotBase !************************************************************ ! potentials. ! ! It includes definitions of -! -- TPBU, Lennard-Jones (12-6) potential -! -- TPBQ, Transfer function +! -- TPBU, Lennard-Jones (12-6) potential; +! -- TPBQ, Transfer function, ! -! All default values are adjusted for non-bonded carbob-carbon interaction in carbon nanotubes. +! All default values are adjusted for non-bonded carbon-carbon interaction in carbon nanotubes. ! !*************************************************************************************************** use TPMLib -use iso_c_binding, only : c_int, c_double, c_char + implicit none !--------------------------------------------------------------------------------------------------- @@ -46,87 +30,83 @@ implicit none !--------------------------------------------------------------------------------------------------- ! Types of the potential with respect to the breathing mode - integer(c_int), parameter :: TP_POT_MONO_R = 0 - integer(c_int), parameter :: TP_POT_POLY_R = 1 + integer*4, parameter :: TP_POT_MONO_R = 0 + integer*4, parameter :: TP_POT_POLY_R = 1 - ! Maximal number of elements in corresponding tables - integer(c_int), parameter :: TPBNMAX = 2001 + ! Maximum number of elements in corresponding tables + integer*4, parameter :: TPBNMAX = 2001 ! Numerical constants - real(c_double), parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5 + real*8, parameter :: TPbConstD = 5.196152422706632d+00 ! = 3.0**1.5 ! Mass of C atom - real(c_double), parameter :: TPBMc = 12.0107d+00 ! (Da) + real*8, parameter :: TPBMc = 12.0107d+00 ! (Da) - ! Parameters of the Van der Waals inteaction between carbon atoms in graphene sheets, see + ! Parameters of the Van der Waals interaction between carbon atoms in graphene sheets, see ! Stuart S.J., Tutein A.B., Harrison J.A., J. Chem. Phys. 112(14), 2000 - real(c_double), parameter :: TPBEcc = 0.00284d+00 ! (eV) - real(c_double), parameter :: TPBScc = 3.4d+00 ! (A) + real*8, parameter :: TPBEcc = 0.00284d+00 ! (eV) + real*8, parameter :: TPBScc = 3.4d+00 ! (A) - ! Lattice parameter and numerical density of atoms for a graphene sheet, see + ! Lattice parameter and surface number density of atoms for a graphene sheet, see ! Dresselhaus et al, Carbon 33(7), 1995 - real(c_double), parameter :: TPBAcc = 1.421d+00 ! (A) - real(c_double), parameter :: TPBDcc = 4.0d+00 / ( TPBConstD * TPBAcc * TPBAcc ) ! (1/A^2) + real*8, parameter :: TPBAcc = 1.421d+00 ! (A) + real*8, parameter :: TPBDcc = 4.0d+00 / ( TPBConstD * TPBAcc * TPBAcc ) ! (1/A^2) ! Specific heat of carbon nanotubes - real(c_double), parameter :: TPBSHcc = 600.0d+00 / K_MDCU ! (eV/(Da*K)) + real*8, parameter :: TPBSHcc = 600.0d+00 / K_MDCU ! (eV/(Da*K)) - ! Cutoff distances for interactomic potential and transfer function + ! Cutoff distances for interactomic potential and transfer function. ! Changes in these parameters can result in necessity to change some numerical parameters too. - real(c_double), parameter :: TPBRmincc = 0.001d+00 * TPBScc ! (A) - real(c_double), parameter :: TPBRcutoffcc = 3.0d+00 * TPBScc ! (A) - real(c_double), parameter :: TPBRcutoff1cc = 2.16d+00 * TPBScc ! (A) + real*8, parameter :: TPBRmincc = 0.001d+00 * TPBScc ! (A) + real*8, parameter :: TPBRcutoffcc = 3.0d+00 * TPBScc ! (A) + real*8, parameter :: TPBRcutoff1cc = 2.16d+00 * TPBScc ! (A) ! Parameters of the transfer function for non-bonded interaction between carbon atoms - !real(c_double), parameter :: TPBQScc = TPBScc ! (A) - !real(c_double), parameter :: TPBQRcutoff1cc = 2.16d+00 * TPBScc ! (A) - real(c_double), parameter :: TPBQScc = 7.0d+00 ! (A) - real(c_double), parameter :: TPBQRcutoff1cc = 8.0d+00 ! (A) + real*8, parameter :: TPBQScc = 7.0d+00 ! (A) + real*8, parameter :: TPBQRcutoff1cc = 8.0d+00 ! (A) !--------------------------------------------------------------------------------------------------- ! Global variables !--------------------------------------------------------------------------------------------------- - logical :: TPErrCheck = .true. ! Set to .true. to generate diagnostic and warning messages - character*512 :: TPErrMsg = '' ! Typically, this variable is set up in F_tt () + logical :: TPErrCheck = .true. ! Set to .true. to generate diagnostic and warning messages + character*512 :: TPErrMsg = '' - real(c_double) :: TPGeomPrec = 1.0d-06 ! Geometric precision, see TPInt - integer(c_int) :: TPPotType = TP_POT_MONO_R ! Type of the potential with respect to the breathing mode + real*8 :: TPGeomPrec = 1.0d-06 ! Geometric precision, see TPInt + integer*4 :: TPPotType = TP_POT_MONO_R ! Type of the potential with respect to the breathing mode - ! Physical parameters of the interatomic potential and atoms distribution at the surface - ! of the tube + ! Parameters of the interatomic potential and atoms distribution at the nanotube surface - real(c_double) :: TPBM = TPBMc ! Mass of an atom, Da - real(c_double) :: TPBE = TPBEcc ! Depth of the energy well in LJ (12-6) interatomic potential (eV) - real(c_double) :: TPBS = TPBScc ! Sigma parameter of LJ (12-6) interatomic potential (A) - real(c_double) :: TPBD = TPBDcc ! Numerical density of atoms at the tube surface (1/A^2) - real(c_double) :: TPBSH = TPBSHcc ! Specific heat (eV/(Da*K)) + real*8 :: TPBM = TPBMc ! Mass of an atom (Da) + real*8 :: TPBE = TPBEcc ! Depth of the energy well in (12-6) LJ interatomic potential (eV) + real*8 :: TPBS = TPBScc ! Sigma parameter of (12-6) LJ interatomic potential (A) + real*8 :: TPBD = TPBDcc ! Numerical density of atoms at the tube surface (1/A^2) + real*8 :: TPBSH = TPBSHcc ! Specific heat (eV/(Da*K)) - real(c_double) :: TPBRmin = TPBRmincc ! (A) - real(c_double) :: TPBRcutoff = TPBRcutoffcc ! (A) - real(c_double) :: TPBRcutoff1 = TPBRcutoff1cc ! (A) + real*8 :: TPBRmin = TPBRmincc ! (A) + real*8 :: TPBRcutoff = TPBRcutoffcc ! (A) + real*8 :: TPBRcutoff1 = TPBRcutoff1cc ! (A) ! Physical parameters of the transfer function - real(c_double) :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A) - real(c_double) :: TPBQRcutoff1 = TPBQRcutoff1cc ! (A) + real*8 :: TPBQS = TPBQScc ! Sigma parameter of the transfer function (A) + real*8 :: TPBQRcutoff1 = TPBQRcutoff1cc ! (A) - ! Auxilary variables + ! Auxiliary variables - real(c_double) :: TPBE4, TPBE24, TPBDRcutoff, TPBQDRcutoff - real(c_double) :: TPBQR0 ! Constant-value distance for the transfer function (A) + real*8 :: TPBE4, TPBE24, TPBDRcutoff, TPBQDRcutoff + real*8 :: TPBQR0 ! Constant-value distance for the transfer function (A) ! Table of inter-particle potential, force, and transfer function - integer(c_int) :: TPBN = TPBNMAX - real(c_double) :: TPBDR - real(c_double), dimension(0:TPBNMAX-1) :: TPBQ - real(c_double), dimension(0:TPBNMAX-1) :: TPBU, TPBdUdR + integer*4 :: TPBN = TPBNMAX + real*8 :: TPBDR + real*8, dimension(0:TPBNMAX-1) :: TPBQ + real*8, dimension(0:TPBNMAX-1) :: TPBU, TPBdUdR contains !****************************************************************************************** - integer(c_int) function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !TPBsizeof = sizeof ( TPBU ) + sizeof ( TPBdUdR ) + integer*4 function TPBsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! TPBsizeof = 8 * ( size ( TPBQ ) + size ( TPBU ) + size ( TPBdUdR ) ) end function TPBsizeof !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -134,11 +114,11 @@ contains !********************************************************************** ! Interpolation !--------------------------------------------------------------------------------------------------- - real(c_double) function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: R + real*8 function TPBQInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: R !------------------------------------------------------------------------------------------- - real(c_double) :: Z, RR - integer(c_int) :: i + real*8 :: Z, RR + integer*4 :: i !------------------------------------------------------------------------------------------- if ( R < TPBRmin ) then !call PrintStdLogMsg ( TPErrMsg ) @@ -155,11 +135,11 @@ contains !********************************************************************** TPBQInt0 = TPBQ(i) * Z + TPBQ(i+1) * RR end function TPBQInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: R + real*8 function TPBUInt0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: R !------------------------------------------------------------------------------------------- - real(c_double) :: Z, RR - integer(c_int) :: i + real*8 :: Z, RR + integer*4 :: i !------------------------------------------------------------------------------------------- if ( R < TPBRmin ) then !call PrintStdLogMsg ( TPErrMsg ) @@ -177,11 +157,11 @@ contains !********************************************************************** end function TPBUInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPBUInt1 ( U, dUdR, R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: U, dUdR - real(c_double), intent(in) :: R + real*8, intent(out) :: U, dUdR + real*8, intent(in) :: R !------------------------------------------------------------------------------------------- - real(c_double) :: Z, RR - integer(c_int) :: i + real*8 :: Z, RR + integer*4 :: i !------------------------------------------------------------------------------------------- if ( R < TPBRmin ) then !call PrintStdLogMsg ( TPErrMsg ) @@ -204,10 +184,10 @@ contains !********************************************************************** ! Calculation !--------------------------------------------------------------------------------------------------- - real(c_double) function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: R + real*8 function TPBQCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: R !------------------------------------------------------------------------------------------- - real(c_double) :: Z, t, S + real*8 :: Z, t, S !------------------------------------------------------------------------------------------- if ( R > TPBRcutoff ) then TPBQCalc0 = 0.0d+00 @@ -226,10 +206,10 @@ contains !********************************************************************** endif end function TPBQCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: R + real*8 function TPBUCalc0 ( R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: R !------------------------------------------------------------------------------------------- - real(c_double) :: Z, t, S + real*8 :: Z, t, S !------------------------------------------------------------------------------------------- if ( R > TPBRcutoff ) then TPBUCalc0 = 0.0d+00 @@ -247,9 +227,9 @@ contains !********************************************************************** end function TPBUCalc0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPBUCalc1 ( U, dUdR, R ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: U, dUdR - real(c_double), intent(in) :: R - real(c_double) :: Z, t, S, dSdR + real*8, intent(out) :: U, dUdR + real*8, intent(in) :: R + real*8 :: Z, t, S, dSdR !------------------------------------------------------------------------------------------- if ( R > TPBRcutoff ) then U = 0.0d+00 @@ -271,11 +251,11 @@ contains !********************************************************************** end subroutine TPBUCalc1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPBSegmentForces ( F1, F2, F, M, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), dimension(0:2), intent(out) :: F1, F2 - real(c_double), dimension(0:2), intent(in) :: F, M, Laxis - real(c_double), intent(in) :: L + real*8, dimension(0:2), intent(out) :: F1, F2 + real*8, dimension(0:2), intent(in) :: F, M, Laxis + real*8, intent(in) :: L !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: FF, MM, FFF + real*8, dimension(0:2) :: FF, MM, FFF !------------------------------------------------------------------------------------------- FF = 0.5d+00 * F MM = M / L @@ -284,36 +264,13 @@ contains !********************************************************************** F2 = FF + FFF end subroutine TPBSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!--------------------------------------------------------------------------------------------------- -! Printing -!--------------------------------------------------------------------------------------------------- - -! subroutine TPBPrint ( FileName ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! character(c_char)*(*), intent(in) :: FileName -! !------------------------------------------------------------------------------------------- -! integer(c_int) :: Fuid -! integer(c_int) :: i -! real(c_double) :: R -! !------------------------------------------------------------------------------------------- -! Fuid = OpenFile ( FileName, "wt", outputpath ) -! write ( Fuid, '(a)' ) 'TITLE="TPB Potentials"' -! write ( Fuid, '(a)' ) 'VARIABLES="R" "Q" "U" "dUdR"' -! write ( Fuid, '(a)' ) 'ZONE' -! R = TPBRmin -! do i = 0, TPBN - 1 -! write ( Fuid, '(4e22.12)' ) R, TPBQ(i), TPBU(i), TPBDUDR(i) -! R = R + TPBDR -! end do -! call CloseFile ( Fuid ) -! end subroutine TPBPrint !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !--------------------------------------------------------------------------------------------------- ! Initialization !--------------------------------------------------------------------------------------------------- subroutine TPBInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) :: R - integer(c_int) :: i + real*8 :: R + integer*4 :: i !------------------------------------------------------------------------------------------- TPBE4 = 4.0d+00 * TPBE TPBE24 = - 24.0d+00 * TPBE diff --git a/tools/mesont/TubePotMono.f90 b/tools/mesont/TMDPotGen/TubePotMono.f90 similarity index 73% rename from tools/mesont/TubePotMono.f90 rename to tools/mesont/TMDPotGen/TubePotMono.f90 index 587b1568df..97ddc8c4a5 100644 --- a/tools/mesont/TubePotMono.f90 +++ b/tools/mesont/TMDPotGen/TubePotMono.f90 @@ -1,49 +1,34 @@ -! ------------ ---------------------------------------------------------- -! 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 TubePotMono !******************************************************************************** ! -! TMD Library: Approximate tubular potentials and transfer functions for mono-radius tubes +! Approximate tubular potentials and transfer functions for mono-radius tubes ! !--------------------------------------------------------------------------------------------------- ! ! Intel Fortran ! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, 2020, Version 13.00 +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020 ! !--------------------------------------------------------------------------------------------------- ! -! Four potentials and transfer functions are calculated in this module: +! Four potentials and transfer functions are determined in this module: ! -! 1. SSTP (segment - semi-infinite tube parallel). It gives a linear density of the potential along -! the segment axis which produced by a parallel semi-infinite tube. 2D tables for this potential +! 1. SSTP (segment - semi-infinite tube parallel): Linear density of the potential along +! the segment axis which is produced by a parallel semi-infinite tube. 2D tables for this potential ! are generated at initialization or can be loaded from a file ! -! 2. STP (segment - tube parallel). It gives a linear density of the potential along the segment axis -! which produced by a parallel infinite tubes. This is only a particular case of the SSTP potential, -! but it is considered separately for computational effiency. 1D tables of this potential are taken -! from 2D tables of SSTP potential. +! 2. STP (segment - tube parallel): Linear density of the potential along the segment axis +! which is produced by a parallel infinite tube. This is only a particular case of the SSTP potential, +! but it is considered separately for computational efficiency. 1D tables of this potential are taken +! from 2D tables of the SSTP potential. ! -! 3. SST (segment - semi-infinite tube). It gives a potential for a segment produced by a arbitrary- -! oriented semi-infinite tube. Data of this potential can not be kept in 2D tabels, therefore all +! 3. SST (segment - semi-infinite tube): Potential for a segment produced by an arbitrary- +! oriented semi-infinite tube. Data of this potential can not be kept in 2D tables, therefore all ! data are calculated 'on fly' with the help of SSTP potential and numerical integration along the -! segment axis +! segment axis. ! -! 4. ST (segment - tube). It gives a potential for a segment produced by a arbitrary-oriented +! 4. ST (segment - tube): A potential for a segment produced by a arbitrary-oriented ! infinitely long tube. 2D tables for this potential are generated at initialization or can be -! loaded from a file +! loaded from a file. ! !*************************************************************************************************** @@ -53,123 +38,128 @@ use TubePotBase use TubePotTrue use LinFun2 use Spline2 -use iso_c_binding, only : c_int, c_double, c_char + implicit none !--------------------------------------------------------------------------------------------------- ! Constants !--------------------------------------------------------------------------------------------------- - integer(c_int), parameter :: TPMNZMAX = 129 - integer(c_int), parameter :: TPMNEMAX = 128 + integer*4, parameter :: TPMNZMAX = 129 + integer*4, parameter :: TPMNEMAX = 128 - integer(c_int), parameter :: TPMNHMAX = 1001 - integer(c_int), parameter :: TPMNXMAX = 1001 - integer(c_int), parameter :: TPMNMAX = 1001 + integer*4, parameter :: TPMNHMAX = 1001 + integer*4, parameter :: TPMNXMAX = 1001 + integer*4, parameter :: TPMNMAX = 1001 !--------------------------------------------------------------------------------------------------- ! Global variables !--------------------------------------------------------------------------------------------------- - integer(c_int) :: TPMStartMode = 1 - character*512 :: TPMSSTPFile = 'TPMSSTP.xrs' - character*512 :: TPMAFile = 'TPMA.xrs' + integer*4 :: TPMStartMode = 1 + + character*512 :: TPMFile = 'MESONT-TABTP.xrs' + integer*4 :: TPMUnitID ! Unit for the tabulated potential file + - integer(c_int) :: TPMNZ = TPMNZMAX - integer(c_int) :: TPMNZ1 = TPMNZMAX - 1 - integer(c_int) :: TPMNE = TPMNEMAX - integer(c_int) :: TPMNE1 = TPMNEMAX - 1 + integer*4 :: TPMNZ = TPMNZMAX + integer*4 :: TPMNZ1 = TPMNZMAX - 1 + integer*4 :: TPMNE = TPMNEMAX + integer*4 :: TPMNE1 = TPMNEMAX - 1 - integer(c_int) :: TPMNH = TPMNHMAX - integer(c_int) :: TPMNH1 = TPMNHMAX - 1 - integer(c_int) :: TPMNX = TPMNXMAX - integer(c_int) :: TPMNX1 = TPMNXMAX - 1 + integer*4 :: TPMNH = TPMNHMAX + integer*4 :: TPMNH1 = TPMNHMAX - 1 + integer*4 :: TPMNX = TPMNXMAX + integer*4 :: TPMNX1 = TPMNXMAX - 1 integer :: TPMChiIndM ! Chirality index M integer :: TPMChiIndN ! Chirality index N - real(c_double) :: TPMR1 - real(c_double) :: TPMR2 + real*8 :: TPMR1 + real*8 :: TPMR2 - real(c_double) :: TPMHmax - real(c_double) :: TPMDH + real*8 :: TPMHmax + real*8 :: TPMDH ! Parameters of empirical correction functions - integer(c_int) :: TPMAN = 20 - real(c_double) :: TPMAHmin - real(c_double) :: TPMAHmax - real(c_double) :: TPMADH - real(c_double), dimension(0:TPMNHMAX-1) :: TPMAH, TPMAF, TPMAFxx + integer*4 :: TPMAN = 20 + real*8 :: TPMAHmin + real*8 :: TPMAHmax + real*8 :: TPMADH + real*8, dimension(0:TPMNHMAX-1) :: TPMAH, TPMAF, TPMAFxx ! Fitting parameters that depend on the SWCNT chirality - real(c_double) :: TPMCaA = 0.22d+00 ! 0.22 for (10,10) CNTs - real(c_double) :: TPMCeA = 0.35d+00 ! 0.35 for (10,10) CNTs - real(c_double) :: TPMAHmin0 = 10.0d+00 ! 10.0 A for (10,10) CNTs + real*8 :: TPMCaA = 0.22d+00 ! 0.22 for (10,10) CNTs + real*8 :: TPMCeA = 0.35d+00 ! 0.35 for (10,10) CNTs + real*8 :: TPMAHmin0 = 10.0d+00 ! 10.0 A for (10,10) CNTs ! Parameters of SSTP integrator - real(c_double) :: TPMDE - real(c_double), dimension(0:TPMNEMAX-1) :: TPMCE, TPMSE + real*8 :: TPMDE + real*8, dimension(0:TPMNEMAX-1) :: TPMCE, TPMSE ! Additional parameters for SSTP potential - real(c_double) :: TPMSSTPDelta = 0.25d+00 - integer(c_int) :: TPMSSTPNH - integer(c_int) :: TPMSSTPNX + real*8 :: TPMSSTPDelta = 0.25d+00 + integer*4 :: TPMSSTPNH + integer*4 :: TPMSSTPNX - real(c_double) :: TPMSSTPX1 - real(c_double) :: TPMSSTPXmax - real(c_double) :: TPMSSTPDX + real*8 :: TPMSSTPX1 + real*8 :: TPMSSTPXmax + real*8 :: TPMSSTPDX - real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSSTPG - real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy - real(c_double), dimension(0:TPMNHMAX-1) :: TPMSSTPH - real(c_double), dimension(0:TPMNXMAX-1) :: TPMSSTPX + real*8, dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSSTPG + real*8, dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy + real*8, dimension(0:TPMNHMAX-1) :: TPMSSTPH + real*8, dimension(0:TPMNXMAX-1) :: TPMSSTPX ! Additional parameters for STP potential - ! In calcuation of this potential also some parameters of SSTP potential are used + ! In calculation of this potential some parameters of SSTP potential are also used. ! In particular, STP potential has no its own integrator. All data comes from SSTP integrator. ! It does not result in any computational inefficiency unless the STP potential is used without SSTP one. - integer(c_int) :: TPMNN = 10 - real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPG - real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTPF, TPMSTPFxx + integer*4 :: TPMNN = 10 + real*8, dimension(0:TPMNHMAX-1) :: TPMSTPG + real*8, dimension(0:TPMNHMAX-1) :: TPMSTPF, TPMSTPFxx ! Parameters for ST potential - real(c_double) :: TPMSTDelta = 1.0d+00 ! Minimal gap dh for ST-potential - integer(c_int) :: TPMSTNXS = 10 ! Number of subdivisions for every grid step in ST-integrator - real(c_double) :: TPMSTXmax - real(c_double) :: TPMSTH1 - real(c_double) :: TPMSTH2 - real(c_double) :: TPMSTDH12 + ! Minimal gap dh for ST-potential + real*8 :: TPMSTDelta = 1.0d+00 + ! Number of subdivisions for every grid step in ST-integrator + integer*4 :: TPMSTNXS = 10 + real*8 :: TPMSTXmax + real*8 :: TPMSTH1 + real*8 :: TPMSTH2 + real*8 :: TPMSTDH12 - real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSTG - real(c_double), dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy - real(c_double), dimension(0:TPMNHMAX-1) :: TPMSTH - real(c_double), dimension(0:TPMNXMAX-1) :: TPMSTX + real*8, dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSTG + real*8, dimension(0:TPMNHMAX-1,0:TPMNXMAX-1) :: TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy + real*8, dimension(0:TPMNHMAX-1) :: TPMSTH + real*8, dimension(0:TPMNXMAX-1) :: TPMSTX ! Switching parameters ! Height switch (at H=0 in SST-potential) - integer(c_int) :: TPMHSwitch = 0 ! 1, use h-switch; 0, do not use the switch - real(c_double) :: TPMHS = 3.0d+00 ! Switch height, Angstrom + integer*4 :: TPMHSwitch = 0 ! 1, use h-switch; 0, do not use the switch + real*8 :: TPMHS = 3.0d+00 ! Switch height, Angstrom ! Angle switch - integer(c_int) :: TPMASwitch = 0 ! 1, use a-switch; 0, do not use the switch - real(c_double) :: TPMAS = 3.0d+00 ! Switch angle, degree - real(c_double) :: TPMASMin - real(c_double) :: TPMASMax - real(c_double) :: TPMASDelta + integer*4 :: TPMASwitch = 0 ! 1, use a-switch; 0, do not use the switch + real*8 :: TPMAS = 3.0d+00 ! Switch angle, degree + real*8 :: TPMASMin + real*8 :: TPMASMax + real*8 :: TPMASDelta ! These variables are used to print error message if intertube force filed fails - integer(c_int) :: Err_CNT1 = 0, Err_CNT1_Node = 0, Err_CNT2 = 0, Err_CNT2_Node1 = 0, Err_CNT2_Node2 = 0, Err_EType = 0 + integer*4 :: Err_CNT1 = 0, Err_CNT1_Node = 0, Err_CNT2 = 0 + integer*4 :: Err_CNT2_Node1 = 0, Err_CNT2_Node2 = 0, Err_EType = 0 contains !****************************************************************************************** - integer(c_int) function TPMsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPMsizeof () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! TPMsizeof = 8 * ( size ( TPMAH ) + size ( TPMAF ) + size ( TPMAFxx ) & + size ( TPMCE ) + size ( TPMSE ) + size ( TPMSSTPG ) + size ( TPMSSTPF ) & + size ( TPMSSTPFxx ) + size ( TPMSSTPFyy ) + size ( TPMSSTPFxxyy ) & @@ -183,23 +173,24 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- subroutine PrintTPErrMsg () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !write ( TPErrMsg, fmt = '(a,i8,a,i8,a,i8,a,i8,a,i8,a,i1)' ) 'CNT ', Err_CNT1, ' [', Err_CNT1_Node,'] with CNT ', Err_CNT2, ' [', Err_CNT2_Node1, ', ', Err_CNT2_Node2, '] E=', Err_EType + !write ( TPErrMsg, fmt = '(a,i8,a,i8,a,i8,a,i8,a,i8,a,i1)' ) 'CNT ', Err_CNT1, ' [', Err_CNT1_Node,'] with CNT ', & + ! & Err_CNT2, ' [', Err_CNT2_Node1, ', ', Err_CNT2_Node2, '] E=', Err_EType !call PrintStdLogMsg ( TPErrMsg ) end subroutine PrintTPErrMsg !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! SSTP: Linear potential density for the tube interacting with parallel semi-infinte tube +! SSTP: Linear potential density for the tube interacting with parallel semi-infinite tube !--------------------------------------------------------------------------------------------------- subroutine TPMSSTPIntegrator ( Q, U, H, D ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function calculates the transfer function Q and potential U between an infinitely long - ! tube and a cross-section of another parallel tube for given height H and displacemnet D. + ! tube and a cross-section of another parallel tube for given height H and displacement D. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), intent(in) :: H, D + real*8, intent(out) :: Q, U + real*8, intent(in) :: H, D !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j, k - real(c_double) :: C, Zmin, Zmax, DZ, R1X, R1Y, R2X, R2Y, R2Z, R, Rcutoff2 + integer*4 :: i, j, k + real*8 :: C, Zmin, Zmax, DZ, R1X, R1Y, R2X, R2Y, R2Z, R, Rcutoff2 !------------------------------------------------------------------------------------------- Q = 0.0d+00 U = 0.0d+00 @@ -236,15 +227,15 @@ contains !********************************************************************** U = U * sqr ( TPBD ) * C end subroutine TPMSSTPIntegrator !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPInt0 ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPMSSTPInt0 ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the transfer function Q and potential U for the SSTP potential - ! calculated with interpolation in the table without switch + ! calculated by interpolation in the table without switch. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), intent(in) :: H, X + real*8, intent(out) :: Q, U + real*8, intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j - real(c_double) :: XX + integer*4 :: i, j + real*8 :: XX !------------------------------------------------------------------------------------------- i = 1 + int ( H / TPMDH ) j = 1 + int ( ( X + TPMSSTPXMax ) / TPMSSTPDX ) @@ -270,19 +261,20 @@ contains !********************************************************************** XX = X end if Q = CalcLinFun2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPG ) - U = CalcSpline2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy ) + U = CalcSpline2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, & + TPMSSTPFyy, TPMSSTPFxxyy ) TPMSSTPInt0 = 1 end function TPMSSTPInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPInt0S ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPMSSTPInt0S ( Q, U, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the transfer function Q and potential U for the SSTP potential - ! calculated with interpolation in the table and switch to the case of zero H + ! calculated by interpolation in the table and switch to the case of zero H. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), intent(in) :: H, X + real*8, intent(out) :: Q, U + real*8, intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: IntSign - real(c_double) :: t, W, Qa, Ua + integer*4 :: IntSign + real*8 :: t, W, Qa, Ua !------------------------------------------------------------------------------------------- if ( TPMHSwitch == 0 ) then TPMSSTPInt0S = TPMSSTPInt0 ( Q, U, H, X ) @@ -300,15 +292,15 @@ contains !********************************************************************** end if end function TPMSSTPInt0S !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPInt1 ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function returns the transfer function Q, potential U, and derivarives Uh=dU/dH and - ! Ux=dU/dX for the SSTP potential calculated with interpolation in the table without switch + integer*4 function TPMSSTPInt1 ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This function returns the transfer function Q, potential U, and derivatives Uh=dU/dH and + ! Ux=dU/dX for the SSTP potential calculated by interpolation in the table without switch. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U, Uh, Ux - real(c_double), intent(in) :: H, X + real*8, intent(out) :: Q, U, Uh, Ux + real*8, intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j - real(c_double) :: XX + integer*4 :: i, j + real*8 :: XX !------------------------------------------------------------------------------------------- i = 1 + int ( H / TPMDH ) j = 1 + int ( ( X + TPMSSTPXMax ) / TPMSSTPDX ) @@ -336,20 +328,21 @@ contains !********************************************************************** XX = X end if Q = CalcLinFun2_0 ( i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPG ) - call CalcSpline2_1 ( U, Uh, Ux, i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy ) + call CalcSpline2_1 ( U, Uh, Ux, i, j, H, XX, TPMNH, TPMNX, TPMSSTPH, TPMSSTPX, TPMSSTPF, & + TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy ) TPMSSTPInt1 = 1 end function TPMSSTPInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPInt1S ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function returns the transfer function Q, potential U, and derivarives Uh=dU/dH and - ! Ux=dU/dX for the SSTP potential calculated with interpolation in the table and switch to + integer*4 function TPMSSTPInt1S ( Q, U, Uh, Ux, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! This function returns the transfer function Q, potential U, and derivatives Uh=dU/dH and + ! Ux=dU/dX for the SSTP potential calculated by interpolation in the table and switch to ! the case of zero H. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U, Uh, Ux - real(c_double), intent(in) :: H, X + real*8, intent(out) :: Q, U, Uh, Ux + real*8, intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: IntSign - real(c_double) :: t, W, W1, dWdH, Qa, Ua, Uha, Uxa + integer*4 :: IntSign + real*8 :: t, W, W1, dWdH, Qa, Ua, Uha, Uxa !------------------------------------------------------------------------------------------- if ( TPMHSwitch == 0 ) then TPMSSTPInt1S = TPMSSTPInt1 ( Q, U, Uh, Ux, H, X ) @@ -372,28 +365,25 @@ contains !********************************************************************** end function TPMSSTPInt1S !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSSTPWrite () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function writes the table of the SSTP potential to the disk file + ! This function writes the table of the SSTP potential to a disk file. !------------------------------------------------------------------------------------------- - integer(c_int) :: Fuid, i, j + integer*4 :: i, j !------------------------------------------------------------------------------------------- - Fuid = OpenFile ( TPMSSTPFile, 'wt', '' ) - write ( unit = Fuid, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMNH1, TPMNX1 + write ( unit = TPMUnitID, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMNH1, TPMNX1 do i = 0, TPMNH1 do j = 0, TPMNX1 - if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) write ( unit = Fuid, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j) + if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) write ( unit = TPMUnitID, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j) end do end do - call CloseFile ( Fuid ) end subroutine TPMSSTPWrite !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSSTPRead () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function reads the table of the SSTP potential from the disk file + ! This function reads the table of the SSTP potential from a disk file. !------------------------------------------------------------------------------------------- - integer(c_int) :: Fuid, i, j - integer(c_int) :: iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1 + integer*4 :: i, j + integer*4 :: iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1 !------------------------------------------------------------------------------------------- - Fuid = OpenFile ( TPMSSTPFile, 'rt', '' ) - read ( unit = Fuid, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1 + read ( unit = TPMUnitID, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMNH1, iTPMNX1 if ( iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN ) then print *, 'ERROR in [TPMSSTPRead]: iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN' stop @@ -404,19 +394,18 @@ contains !********************************************************************** end if do i = 0, TPMNH1 do j = 0, TPMNX1 - if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) read ( unit = Fuid, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j) + if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) read ( unit = TPMUnitID, fmt = '(2e26.17)' ) TPMSSTPG(i,j), TPMSSTPF(i,j) end do end do - call CloseFile ( Fuid ) end subroutine TPMSSTPRead !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSSTPInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function calculates the table of the SSTP potential + ! This function calculates the table of the SSTP potential. !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j - real(c_double) :: E - character(c_char) :: Msg - real(c_double), dimension(0:TPMNMAX-1) :: FF, DD, MM, K0, K1, K2 + integer*4 :: i, j + real*8 :: E + character*512 :: Msg + real*8, dimension(0:TPMNMAX-1) :: FF, DD, MM, K0, K1, K2 !------------------------------------------------------------------------------------------- TPMDE = M_2PI / TPMNE E = 0.0d+00 @@ -441,7 +430,8 @@ contains !********************************************************************** do j = 0, TPMNX1 if ( ( i .ge. TPMSSTPNH ) .or. ( j .le. TPMSSTPNX ) ) then call TPMSSTPIntegrator ( TPMSSTPG(i,j), TPMSSTPF(i,j), TPMSSTPH(i), TPMSSTPX(j) ) - print '(2i5,a,e20.10,a,e20.10,a,e20.10,a,e20.10)', i, j, ' H=', TPMSSTPH(i), ', X=', TPMSSTPX(j), ', Q=', TPMSSTPG(i,j), ', U=', TPMSSTPF(i,j) + print '(2i5,a,e20.10,a,e20.10,a,e20.10,a,e20.10)', i, j, ' H=', TPMSSTPH(i), & + ', X=', TPMSSTPX(j), ', Q=', TPMSSTPG(i,j), ', U=', TPMSSTPF(i,j) end if end do end do @@ -449,22 +439,23 @@ contains !********************************************************************** else call TPMSSTPRead () end if - call CreateSpline2Ext ( 3, 3, 3, 3, TPMNH, TPMSSTPNH, TPMNX, TPMSSTPNX, TPMNMAX, TPMSSTPH, TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy, FF, MM, DD, K0, K1, K2 ) + call CreateSpline2Ext ( 3, 3, 3, 3, TPMNH, TPMSSTPNH, TPMNX, TPMSSTPNX, TPMNMAX, TPMSSTPH, & + TPMSSTPX, TPMSSTPF, TPMSSTPFxx, TPMSSTPFyy, TPMSSTPFxxyy, FF, MM, DD, K0, K1, K2 ) end subroutine TPMSSTPInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! STP Potential for an infinite tube interacting with a parallel segment. No actual initialization -! is necessary for this potential, since the data are taken from the table for SSTP potenrials. +! STP potential for an infinite tube interacting with a parallel segment. No actual initialization +! is necessary for this potential, since the data are taken from the table for SSTP potentials. !--------------------------------------------------------------------------------------------------- - integer(c_int) function TPMSTPInt0 ( Q, U, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPMSTPInt0 ( Q, U, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the transfer function Q and potential U for the STP potential - ! calculated with interpolation in the table + ! calculated with interpolation in the table. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), intent(in) :: H + real*8, intent(out) :: Q, U + real*8, intent(in) :: H !------------------------------------------------------------------------------------------- - integer(c_int) :: i + integer*4 :: i !------------------------------------------------------------------------------------------- i = 1 + int ( H / TPMDH ) if ( i < TPMSSTPNH ) then @@ -485,13 +476,13 @@ contains !********************************************************************** TPMSTPInt0 = 1 end function TPMSTPInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTPInt1 ( Q, U, dUdH, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPMSTPInt1 ( Q, U, dUdH, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the transfer function Q, potential U, and derivative dUdH for - ! the STP potential calculated with interpolation in the table + ! the STP potential calculated by interpolation in the table. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U, dUdH - real(c_double), intent(in) :: H - integer(c_int) :: i + real*8, intent(out) :: Q, U, dUdH + real*8, intent(in) :: H + integer*4 :: i !------------------------------------------------------------------------------------------- i = 1 + int ( H / TPMDH ) if ( i < TPMSSTPNH ) then @@ -513,7 +504,7 @@ contains !********************************************************************** end function TPMSTPInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSTPInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! This function initializes the table of the STP potential + ! This function initializes the table of the STP potential. !------------------------------------------------------------------------------------------- TPMSTPG(0:TPMNH1) = TPMSSTPG(0:TPMNH1,TPMNX1) TPMSTPF(0:TPMNH1) = TPMSSTPF(0:TPMNH1,TPMNX1) @@ -522,25 +513,24 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- ! Fitting functions for SST and ST potential. -! This correction functions are choosen empirically to improve accuracy of SST and ST potentials. +! This correction functions are chosen empirically to improve accuracy of SST and ST potentials. !--------------------------------------------------------------------------------------------------- subroutine TPMAInit ( X1_1, X1_2, X2_1, X2_2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: X1_1, X1_2, X2_1, X2_2 + real*8, intent(in) :: X1_1, X1_2, X2_1, X2_2 !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: R1_1, R1_2, R2_1, R2_2 - real(c_double), dimension(0:2) :: Fa, Ma - real(c_double) :: Qa, Ua, Qb, Ub, X, H, HH, Ucoeff, Uamin, Ubmin - integer(c_int) :: i, j, IntSign, Fuid - real(c_double), dimension(0:TPMNHMAX-1) :: D, K0, K1, K2 - integer(c_int) :: iTPMChiIndM, iTPMChiIndN, iTPMAN + real*8, dimension(0:2) :: R1_1, R1_2, R2_1, R2_2 + real*8, dimension(0:2) :: Fa, Ma + real*8 :: Qa, Ua, Qb, Ub, X, H, HH, Ucoeff, Uamin, Ubmin + integer*4 :: i, j, IntSign + real*8, dimension(0:TPMNHMAX-1) :: D, K0, K1, K2 + integer*4 :: iTPMChiIndM, iTPMChiIndN, iTPMAN !------------------------------------------------------------------------------------------- TPMAHmin = TPMR1 + TPMR2 + TPMSTDelta TPMAHmax = TPMR1 + TPMR2 + 0.95d+00 * TPBRcutoff TPMADH = ( TPMAHmax - TPMAHmin ) / ( TPMAN - 1 ) if ( TPMStartMode == 1 ) then - Fuid = OpenFile ( TPMAFile, 'rt', '' ) - read ( unit = Fuid, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMAN + read ( unit = TPMUnitID, fmt = '(4i8)' ) iTPMChiIndM, iTPMChiIndN, iTPMAN if ( iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN ) then print *, 'ERROR in [TPMAInit]: iTPMChiIndM .NE. TPMChiIndM .OR. iTPMChiIndN .NE. TPMChiIndN' stop @@ -551,9 +541,8 @@ contains !********************************************************************** end if do i = 0, TPMAN - 1 TPMAH(i) = TPMAHmin + i * TPMADH - read ( unit = Fuid, fmt = * ) TPMAF(i) + read ( unit = TPMUnitID, fmt = * ) TPMAF(i) end do - call CloseFile ( Fuid ) call CreateSpline1 ( 3, 3, TPMAN, TPMAH, TPMAF, TPMAFxx, D, K0, K1, K2 ) return end if @@ -583,20 +572,18 @@ contains !********************************************************************** end do TPMAF(i) = Uamin / Ubmin end do - Fuid = OpenFile ( TPMAFile, 'wt', '' ) - write ( unit = Fuid, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMAN + write ( unit = TPMUnitID, fmt = '(4i8)' ) TPMChiIndM, TPMChiIndN, TPMAN do i = 0, TPMAN - 1 - write ( unit = Fuid, fmt = * ) TPMAF(i) + write ( unit = TPMUnitID, fmt = * ) TPMAF(i) end do - call CloseFile ( Fuid ) call CreateSpline1 ( 3, 3, TPMAN, TPMAH, TPMAF, TPMAFxx, D, K0, K1, K2 ) end subroutine TPMAInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMA0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: H + real*8 function TPMA0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: H !------------------------------------------------------------------------------------------- - integer(c_int) :: i - real(c_double) :: A0, t, S + integer*4 :: i + real*8 :: A0, t, S !------------------------------------------------------------------------------------------- if ( H > TPMAHmax ) then TPMA0 = 1.0d+00 @@ -617,11 +604,11 @@ contains !********************************************************************** end function TPMA0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMA1 ( A, Ah, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: A, Ah - real(c_double), intent(in) :: H + real*8, intent(out) :: A, Ah + real*8, intent(in) :: H !------------------------------------------------------------------------------------------- - integer(c_int) :: i - real(c_double) :: A0, t, S, dSdH + integer*4 :: i + real*8 :: A0, t, S, dSdH !------------------------------------------------------------------------------------------- if ( H > TPMAHmax ) then A = 1.0d+00 @@ -646,21 +633,21 @@ contains !********************************************************************** call CalcSpline1_1 ( A, Ah, i, H, TPMAN, TPMAH, TPMAF, TPMAFxx ) end subroutine TPMA1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMCu0 ( H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8 function TPMCu0 ( H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the correction function for the magnitude of the potential. !------------------------------------------------------------------------------------------- - real(c_double), intent(in) :: H, cosA, sinA + real*8, intent(in) :: H, cosA, sinA !------------------------------------------------------------------------------------------- TPMCu0 = 1.0d+00 + ( TPMA0 ( H ) - 1.0d+00 ) * sqr ( sinA ) end function TPMCu0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMCu1 ( Cu, CuH, CuA, H, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Thi subroutine calculates the correction function Cu for magnitude of the potential and - ! its derivatives CuH, CuA. + ! The subroutine calculates the correction function Cu for magnitude of the potential and + ! its derivatives CuH and CuA. !------------------------------------------------------------------------------------------- - real(c_double), intent(ouT) :: Cu, CuH, CuA - real(c_double), intent(in) :: H, cosA, sinA - real(c_double) :: AA, AAh, D + real*8, intent(ouT) :: Cu, CuH, CuA + real*8, intent(in) :: H, cosA, sinA + real*8 :: AA, AAh, D !------------------------------------------------------------------------------------------- call TPMA1 ( AA, AAh, H ) D = sqr ( sinA ) @@ -670,22 +657,22 @@ contains !********************************************************************** CuA = AA * 2.0d+0 * cosA * sinA end subroutine TPMCu1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMCa0 ( cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8 function TPMCa0 ( cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the correction function for the argument of the potential. - ! If correction is not necessary, it should return sinA. + ! If correction is not necessary, it returns sinA. !------------------------------------------------------------------------------------------- - real(c_double), intent(in) :: cosA, sinA + real*8, intent(in) :: cosA, sinA !------------------------------------------------------------------------------------------- TPMCa0 = sinA / ( 1.0d+00 - TPMCaA * sqr ( sinA ) ) end function TPMCa0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMCa1 ( Ca, CaA, Ka, KaA, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine calculates the correction function Cu for the depth of the potential well - ! and its derivatives CuH, CuA. If correction is not necessary, it should return Ca = sinA + ! and its derivatives CuH and CuA. If correction is not necessary, it returns Ca = sinA ! and CaA = cosA. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Ca, CaA, Ka, KaA - real(c_double), intent(in) :: cosA, sinA + real*8, intent(out) :: Ca, CaA, Ka, KaA + real*8, intent(in) :: cosA, sinA !------------------------------------------------------------------------------------------- Ka = 1.0d+00 / ( 1.0d+00 - TPMCaA * sqr ( sinA ) ) Ca = sinA * Ka @@ -693,20 +680,20 @@ contains !********************************************************************** CaA = cosA * Ka + sinA * KaA end subroutine TPMCa1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMCe0 ( sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8 function TPMCe0 ( sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the correction function for the argument of the potential. - ! If correction is not necessary, it should return sinA. + ! If correction is not necessary, it returns sinA. !------------------------------------------------------------------------------------------- - real(c_double), intent(in) :: sinA + real*8, intent(in) :: sinA !------------------------------------------------------------------------------------------- TPMCe0 = 1.0d+00 - TPMCeA * sinA * sinA end function TPMCe0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMCe1 ( Ce, CeA, Ke, cosA, sinA ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! If correction is not necessary, it should return Ce = 1 and CeA = 0. + ! If correction is not necessary, it returns Ce = 1 and CeA = 0. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Ce, CeA, Ke - real(c_double), intent(in) :: cosA, sinA + real*8, intent(out) :: Ce, CeA, Ke + real*8, intent(in) :: cosA, sinA !------------------------------------------------------------------------------------------- Ce = 1.0d+00 - TPMCeA * sinA * sinA CeA = - 2.0d+00 * TPMCeA * sinA * cosA @@ -715,23 +702,23 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- ! SST Potential for the semi-infinite tube interacting with segment. -! This potential does not need any initialization. All necessry data is taken from tables of the +! This potential does not need any initialization. All necessary data is taken from tables of the ! SSTP potential. !--------------------------------------------------------------------------------------------------- - integer(c_int) function TPMSSTPotential ( Q, U, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!!!!!!!!!!! - ! This function calculates the transfer function Q and potenial U applyed to a segment - ! from asemi-infinte tube based on numerical integration (trapesond rule) along the segment - ! axis for non-parallel objects. + integer*4 function TPMSSTPotential ( Q, U, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!!!!!!!!!!! + ! This function calculates the transfer function Q and potential U applied to a segment + ! from a semi-infinite tube based on the numerical integration (trapezoid rule) along + ! the segment axis for non-parallel objects. ! Relative position of the nanotube and segment are given by axial positions of the segment ! ends X1 and X2, height H, cosA= cos(A), where A is the cross-axis angle, and displacement ! D of the nanotube end. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), intent(in) :: X1, X2, H, cosA, D - integer(c_int), intent(in) :: N ! Number of nodes for numerical integration - real(c_double) :: sinA, Qs, Us, DX, X, XX, HH, Cu, Ca, Ce - integer(c_int) :: i + real*8, intent(out) :: Q, U + real*8, intent(in) :: X1, X2, H, cosA, D + integer*4, intent(in) :: N ! Number of nodes for numerical integration + real*8 :: sinA, Qs, Us, DX, X, XX, HH, Cu, Ca, Ce + integer*4 :: i !------------------------------------------------------------------------------------------- Q = 0.0d+00 U = 0.0d+00 @@ -759,18 +746,18 @@ contains !********************************************************************** U = Cu * U * DX end function TPMSSTPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTPotentialPar ( Q, U, R1_1, Laxis1, R2_1, Laxis2, L1, N ) !!!!!!!!!! - ! Potential applyed to the segment from the semi-infinte tube is calculated by numerical - ! integration (trapesond rule) along the segment axis for parallel objects. + integer*4 function TPMSSTPotentialPar ( Q, U, R1_1, Laxis1, R2_1, Laxis2, L1, N ) !!!!!!!!!! + ! Potential applied to a segment from a semi-infinite tube is calculated by the numerical + ! integration (trapezoid rule) along the segment axis for parallel objects. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), dimension(0:2), intent(in) :: R1_1, Laxis1, R2_1, Laxis2 - real(c_double), intent(in) :: L1 - integer(c_int), intent(in) :: N ! Number of nodes for numerical integration + real*8, intent(out) :: Q, U + real*8, dimension(0:2), intent(in) :: R1_1, Laxis1, R2_1, Laxis2 + real*8, intent(in) :: L1 + integer*4, intent(in) :: N ! Number of nodes for numerical integration !------------------------------------------------------------------------------------------- - real(c_double) :: Qs, Us, DX, X, S, H - real(c_double), dimension(0:2) :: R1, L12 - integer(c_int) :: i + real*8 :: Qs, Us, DX, X, S, H + real*8, dimension(0:2) :: R1, L12 + integer*4 :: i !------------------------------------------------------------------------------------------- DX = L1 / ( N - 1 ) X = 0.0d+00 @@ -799,21 +786,21 @@ contains !********************************************************************** U = U * DX end function TPMSSTPotentialPar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTForces ( Q, U, F1, F2, Fd, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!! - ! Potential and forces applyed to the segment from the semi-infinte tube are calculated - ! by numerical integration (trapesond rule) along the segment axis. + integer*4 function TPMSSTForces ( Q, U, F1, F2, Fd, X1, X2, H, cosA, D, N ) !!!!!!!!!!!!!!!! + ! Potential and forces applied to a segment from a semi-infinite tube are calculated + ! by the numerical integration (trapezoid rule) along the segment axis. ! Non-parallel case. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U, Fd - real(c_double), dimension(0:2), intent(out) :: F1, F2 - real(c_double), intent(in) :: X1, X2, H, cosA, D - integer(c_int), intent(in) :: N ! Number of nodes for numerical integration + real*8, intent(out) :: Q, U, Fd + real*8, dimension(0:2), intent(out) :: F1, F2 + real*8, intent(in) :: X1, X2, H, cosA, D + integer*4, intent(in) :: N ! Number of nodes for numerical integration !------------------------------------------------------------------------------------------- - real(c_double) :: DX, sinA - real(c_double) :: Qs, Us, Ush, Usx, Fx, Fy, Fz - real(c_double) :: C, C1, C2, I0, Ih, Ih1, Ih2, Ix, Ix1, X, XX, HH - real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA, Ce, CeA, Ke, Uh, Ua - integer(c_int) :: IntSign, i + real*8 :: DX, sinA + real*8 :: Qs, Us, Ush, Usx, Fx, Fy, Fz + real*8 :: C, C1, C2, I0, Ih, Ih1, Ih2, Ix, Ix1, X, XX, HH + real*8 :: Ca, CaA, Ka, KaA, Cu, CuH, CuA, Ce, CeA, Ke, Uh, Ua + integer*4 :: IntSign, i !------------------------------------------------------------------------------------------- I0 = 0.0d+00 Ih = 0.0d+00 @@ -891,20 +878,20 @@ contains !********************************************************************** Fd = Ce * Ix end function TPMSSTForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSSTForcesPar ( Q, U, F1, F2, Fd, R1_1, Laxis1, R2_1, Laxis2, L1, N ) ! - ! Potential and forces applyed to the segment from the semi-infinte tube are calculated by - ! numerical integration (trapesond rule) along the segment axis. - ! Non-parallel case + integer*4 function TPMSSTForcesPar ( Q, U, F1, F2, Fd, R1_1, Laxis1, R2_1, Laxis2, L1, N ) ! + ! Potential and forces applied to a segment from a semi-infinite tube are calculated by + ! numerical integration (trapezoid rule) along the segment axis. + ! Parallel case. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U, Fd - real(c_double), dimension(0:2), intent(out) :: F1, F2 - real(c_double), dimension(0:2), intent(in) :: R1_1, Laxis1, R2_1, Laxis2 - real(c_double), intent(in) :: L1 - integer(c_int), intent(in) :: N ! Number of nodes for numerical integration + real*8, intent(out) :: Q, U, Fd + real*8, dimension(0:2), intent(out) :: F1, F2 + real*8, dimension(0:2), intent(in) :: R1_1, Laxis1, R2_1, Laxis2 + real*8, intent(in) :: L1 + integer*4, intent(in) :: N ! Number of nodes for numerical integration !------------------------------------------------------------------------------------------- - real(c_double) :: Qs, Us, Ush, Usx, DX, X, S, H, Beta, Gamma - real(c_double), dimension(0:2) :: R1, L12, Fs - integer(c_int) :: i, N1 + real*8 :: Qs, Us, Ush, Usx, DX, X, S, H, Beta, Gamma + real*8, dimension(0:2) :: R1, L12, Fs + integer*4 :: i, N1 !------------------------------------------------------------------------------------------- Q = 0.0d+00 U = 0.0d+00 @@ -955,17 +942,17 @@ contains !********************************************************************** end function TPMSSTForcesPar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! ST: Potential for the infinite tube interacting with segment +! ST: Potential for an infinite tube interacting with a segment !-------------------------------------------------------------------------------------------------- ! - ! These functions are used to smooth boundaries in (H,X) domain for ST potential + ! These functions are used to smooth the boundaries in (H,X) domain for ST potential ! - real(c_double) function TPMSTXMin0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: H + real*8 function TPMSTXMin0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: H !------------------------------------------------------------------------------------------- - real(c_double) :: X + real*8 :: X !------------------------------------------------------------------------------------------- if ( H < TPMSTH1 ) then TPMSTXMin0 = sqrt ( TPMSTH2 * TPMSTH2 - H * H ) @@ -975,20 +962,21 @@ contains !********************************************************************** return end if X = ( H - TPMSTH1 ) / TPMSTDH12 - TPMSTXMin0 = sqrt ( TPMSTH2 * TPMSTH2 - H * H ) * ( 1.0d+00 - X * X * X * ( 3.0d+00 * X * ( 2.0d+00 * X - 5.0d+00 ) + 10.0d+00 ) ) + TPMSTXMin0 = sqrt ( TPMSTH2 * TPMSTH2 - H * H ) & + * ( 1.0d+00 - X * X * X * ( 3.0d+00 * X * ( 2.0d+00 * X - 5.0d+00 ) + 10.0d+00 ) ) end function TPMSTXMin0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) function TPMSTXMax0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: H + real*8 function TPMSTXMax0 ( H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(in) :: H !------------------------------------------------------------------------------------------- TPMSTXMax0 = sqrt ( TPMSTXMax * TPMSTXMax - H * H ) end function TPMSTXMax0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSTXMin1 ( XMin, dXMindH, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: XMin, dXMindH - real(c_double), intent(in) :: H + real*8, intent(out) :: XMin, dXMindH + real*8, intent(in) :: H !------------------------------------------------------------------------------------------- - real(c_double) :: X, F, dFdX + real*8 :: X, F, dFdX !------------------------------------------------------------------------------------------- if ( H < TPMSTH1 ) then XMin = sqrt ( TPMSTH2 * TPMSTH2 - H * H ) @@ -1009,8 +997,8 @@ contains !********************************************************************** end subroutine TPMSTXMin1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSTXMax1 ( XMax, dXMaxdH, H ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: XMax, dXMaxdH - real(c_double), intent(in) :: H + real*8, intent(out) :: XMax, dXMaxdH + real*8, intent(in) :: H !------------------------------------------------------------------------------------------- XMax = sqrt ( TPMSTXMax * TPMSTXMax - H * H ) dXMaxdH = - H / XMax @@ -1021,11 +1009,11 @@ contains !********************************************************************** ! subroutine TPMSTIntegrator ( G, F, Q, U, H, X, DX ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(inout) :: G, F, Q, U - real(c_double), intent(in) :: H, X, DX + real*8, intent(inout) :: G, F, Q, U + real*8, intent(in) :: H, X, DX !------------------------------------------------------------------------------------------- - real(c_double) :: FFx, HH, DDX - integer(c_int) :: IntSign + real*8 :: FFx, HH, DDX + integer*4 :: IntSign !------------------------------------------------------------------------------------------- DDX = 0.5 * DX G = G + Q * DDX @@ -1041,12 +1029,12 @@ contains !********************************************************************** end if end subroutine TPMSTIntegrator !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTInt0 ( G, F, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: G, F - real(c_double), intent(in) :: H, X + integer*4 function TPMSTInt0 ( G, F, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(out) :: G, F + real*8, intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j - real(c_double) :: S, XA, XXX, XXXX, XMin, XMax + integer*4 :: i, j + real*8 :: S, XA, XXX, XXXX, XMin, XMax !------------------------------------------------------------------------------------------- if ( H > TPMHmax ) then G = 0.0d+00 @@ -1083,16 +1071,16 @@ contains !********************************************************************** j = 1 + int ( XXXX * TPMNX1 ) end if G = S * CalcLinFun2_0 ( i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTG ) - F = S * CalcSpline2_0 ( i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy ) + F = S * CalcSpline2_0 ( i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy ) TPMSTInt0 = 1 end function TPMSTInt0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTInt1 ( G, F, Fh, Fx, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(inout) :: G, F, Fh, Fx - real(c_double), intent(in) :: H, X + integer*4 function TPMSTInt1 ( G, F, Fh, Fx, H, X ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(inout) :: G, F, Fh, Fx + real*8, intent(in) :: H, X !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j - real(c_double) :: S, XA, DX, XXX, XXXX, XMin, XMax, dXMindH, dXMaxdH + integer*4 :: i, j + real*8 :: S, XA, DX, XXX, XXXX, XMin, XMax, dXMindH, dXMaxdH !------------------------------------------------------------------------------------------- if ( H > TPMHmax ) then G = 0.0d+00 @@ -1136,7 +1124,8 @@ contains !********************************************************************** j = 1 + int ( XXXX * TPMNX1 ) end if G = S * CalcLinFun2_0 ( i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTG ) - call CalcSpline2_1 ( F, Fh, Fx, i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy ) + call CalcSpline2_1 ( F, Fh, Fx, i, j, H, XXXX, TPMNH, TPMNX, TPMSTH, TPMSTX, & + TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy ) Fx = Fx / DX Fh = Fh - Fx * ( dXMaxdH * XXX + dXMindH * ( 1.0d+00 - XXX ) ) F = F * S @@ -1144,12 +1133,12 @@ contains !********************************************************************** TPMSTInt1 = 1 end function TPMSTInt1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTPotential ( Q, U, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: Q, U - real(c_double), intent(in) :: X1, X2, H, cosA - integer(c_int), intent(in) :: CaseID + integer*4 function TPMSTPotential ( Q, U, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!!!!!!! + real*8, intent(out) :: Q, U + real*8, intent(in) :: X1, X2, H, cosA + integer*4, intent(in) :: CaseID !------------------------------------------------------------------------------------------- - real(c_double) :: sinA, GG1, GG2, FF1, FF2, Ca, Cu + real*8 :: sinA, GG1, GG2, FF1, FF2, Ca, Cu !------------------------------------------------------------------------------------------- if ( CaseID == MD_LINES_PAR ) then TPMSTPotential = TPMSTPInt0 ( Q, U, H ) @@ -1166,17 +1155,17 @@ contains !********************************************************************** U = Cu * ( FF2 - FF1 ) / Ca end function TPMSTPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTForces ( Q, U, F1, F2, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: Q, U - real(c_double), dimension(0:2), intent(out) :: F1, F2 - real(c_double), intent(in) :: X1, X2, H, cosA - integer(c_int), intent(in) :: CaseID + integer*4 function TPMSTForces ( Q, U, F1, F2, X1, X2, H, cosA, CaseID ) !!!!!!!!!!!!!!!!!!! + real*8, intent(out) :: Q, U + real*8, dimension(0:2), intent(out) :: F1, F2 + real*8, intent(in) :: X1, X2, H, cosA + integer*4, intent(in) :: CaseID !------------------------------------------------------------------------------------------- - real(c_double) :: DX, sinA - real(c_double) :: GG1, GG2, FF1, FF2, Fh1, Fh2, Fx1, Fx2 - real(c_double) :: B, C, D - real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA - integer(c_int) :: IntSign1, IntSign2 + real*8 :: DX, sinA + real*8 :: GG1, GG2, FF1, FF2, Fh1, Fh2, Fx1, Fx2 + real*8 :: B, C, D + real*8 :: Ca, CaA, Ka, KaA, Cu, CuH, CuA + integer*4 :: IntSign1, IntSign2 !------------------------------------------------------------------------------------------- DX = X2 - X1 if ( CaseID == MD_LINES_PAR ) then @@ -1227,16 +1216,16 @@ contains !********************************************************************** TPMSTForces = 1 end function TPMSTForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMSTForceTorque( Qi, Ui, Fi, Ti, Q, U, F, T, Psi, PsiA, Cap, L, H, cosA, CaseID ) - real(c_double), intent(out) :: Qi, Ui, Fi, Ti, Q, U, F, T, Psi, PsiA, Cap - real(c_double), intent(in) :: L, H, cosA - integer(c_int), intent(in) :: CaseID + integer*4 function TPMSTForceTorque( Qi, Ui, Fi, Ti, Q, U, F, T, Psi, PsiA, Cap, L, H, cosA, CaseID ) + real*8, intent(out) :: Qi, Ui, Fi, Ti, Q, U, F, T, Psi, PsiA, Cap + real*8, intent(in) :: L, H, cosA + integer*4, intent(in) :: CaseID !------------------------------------------------------------------------------------------- - real(c_double) :: L2, sinA - real(c_double) :: GG, FF, Fh, Fx, GGi, FFi, Fhi, Fxi - real(c_double) :: B, C, D - real(c_double) :: Ca, CaA, Ka, KaA, Cu, CuH, CuA - integer(c_int) :: IntSign + real*8 :: L2, sinA + real*8 :: GG, FF, Fh, Fx, GGi, FFi, Fhi, Fxi + real*8 :: B, C, D + real*8 :: Ca, CaA, Ka, KaA, Cu, CuH, CuA + integer*4 :: IntSign !------------------------------------------------------------------------------------------- if ( CaseID == MD_LINES_PAR ) then TPMSTForceTorque = TPMSTPInt1 ( Q, U, F, H ) @@ -1295,9 +1284,9 @@ contains !********************************************************************** end function TPMSTForceTorque !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPMSTInit () !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) :: X, Q, U, DX, DDX, XMin, XMax - integer(c_int) :: i, j, k - real(c_double), dimension(0:TPMNMAX-1) :: FF, DD, MM, K0, K1, K2 + real*8 :: X, Q, U, DX, DDX, XMin, XMax + integer*4 :: i, j, k + real*8, dimension(0:TPMNMAX-1) :: FF, DD, MM, K0, K1, K2 !------------------------------------------------------------------------------------------- TPMSTH1 = TPMR1 + TPMR2 TPMSTH2 = TPMSTH1 + TPMSTDelta @@ -1330,20 +1319,21 @@ contains !********************************************************************** if ( j < TPMNX1 ) DX = ( XMax - XMin ) * ( TPMSTX(j+1) - TPMSTX(j) ) / TPMSTNXS end do end do - call CreateSpline2 ( 3, 3, 3, 3, TPMNH, TPMNX, TPMNMAX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, TPMSTFyy, TPMSTFxxyy, FF, MM, DD, K0, K1, K2 ) + call CreateSpline2 ( 3, 3, 3, 3, TPMNH, TPMNX, TPMNMAX, TPMSTH, TPMSTX, TPMSTF, TPMSTFxx, & + TPMSTFyy, TPMSTFxxyy, FF, MM, DD, K0, K1, K2 ) end subroutine TPMSTInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- -! Interaction functions: They can be used for calculation of the potential and forces between a -! segment and infinte or semi-infinite nanotube. +! Interaction functions: They can be used for calculations of the potential and forces between a +! segment and an infinite or semi-infinite nanotube. !--------------------------------------------------------------------------------------------------- subroutine TPMSegmentForces ( F2_1, F2_2, F1_1, F1_2, R1_1, R1_2, R2, Laxis2, L2 ) !!!!!!!!! - real(c_double), dimension(0:2), intent(out) :: F2_1, F2_2 - real(c_double), dimension(0:2), intent(in) :: F1_1, F1_2, R1_1, R1_2, R2, Laxis2 - real(c_double), intent(in) :: L2 + real*8, dimension(0:2), intent(out) :: F2_1, F2_2 + real*8, dimension(0:2), intent(in) :: F1_1, F1_2, R1_1, R1_2, R2, Laxis2 + real*8, intent(in) :: L2 !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: F, M, RR + real*8, dimension(0:2) :: F, M, RR !------------------------------------------------------------------------------------------- RR = R1_1 - R2 ! Taking into account periodic boundaries @@ -1359,23 +1349,23 @@ contains !********************************************************************** end subroutine TPMSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! - ! Interaction of a segment with semi-infinite or infinite tube + ! Interaction of a segment with a semi-infinite or infinite tube ! - integer(c_int) function TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, SType2 ) + integer*4 function TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, SType2 ) ! SType2 in the type of the second segment: ! SType2 == 0, internal segment ! Stype2 == 1, point R2_1 is the end of the tube ! Stype2 == 2, point R2_2 in the end of the tube !------------------------------------------------------------------------------------------- - real(c_double), intent(inout) :: Q, U, Fd - real(c_double), dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2 - real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 + real*8, intent(inout) :: Q, U, Fd + 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(c_int) :: SType2 - real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, Ly, DR, F1_1a, F1_2a, F1_1b, F1_2b - real(c_double) :: H, cosA, D1, D2, L1, L2, cosA2, t, W, W1, dWdt, Qa, Ua, Qb, Ub, Fda, Fdb, FF - integer(c_int) :: GeomID, SwitchID, S, IntSigna, IntSignb + integer*4 :: SType2 + real*8, dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, Ly, DR, F1_1a, F1_2a, F1_1b, F1_2b + real*8 :: H, cosA, D1, D2, L1, L2, cosA2, t, W, W1, dWdt, Qa, Ua, Qb, Ub, Fda, Fdb, FF + integer*4 :: GeomID, SwitchID, S, IntSigna, IntSignb !------------------------------------------------------------------------------------------- R1 = 0.5d+00 * ( R1_1 + R1_2 ) R2 = 0.5d+00 * ( R2_1 + R2_2 ) @@ -1486,12 +1476,12 @@ contains !********************************************************************** if ( IntSigna > 0 .or. IntSignb > 0 ) TPMInteractionF = 1 end if - ! Calculation of forces for the comlimentary tube + ! Calculation of forces for the complimentary tube if ( SType2 == 2 ) Laxis2 = - Laxis2 call TPMSegmentForces ( F2_1, F2_2, F1_1, F1_2, R1_1, R1_2, R2, Laxis2, 2.0d+00 * L2 ) - ! After the previous subroutine F2_1*Laxis2 = F2_2*Laxis2, but this is not true for the semi-infinite tube. - ! The force along the tube sould be applied to the end of the tube, while for the - ! another point corresponding force is equal to zero. + ! After the previous subroutine call, F2_1*Laxis2 = F2_2*Laxis2, but this is not true for the semi-infinite tube. + ! The force along the tube should be applied to the end of the tube, while for the + ! another point the corresponding force is equal to zero. if ( SType2 == 1 ) then FF = S_V3xV3 ( F2_1, Laxis2 ) DR = ( Fd - FF ) * Laxis2 @@ -1505,14 +1495,14 @@ contains !********************************************************************** end if end function TPMInteractionF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMInteractionU ( Q, U, R1_1, R1_2, R2_1, R2_2, SType2 ) !!!!!!!!!!!!!!!! - real(c_double), intent(inout) :: Q, U - real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 - integer(c_int), intent(in) :: SType2 + integer*4 function TPMInteractionU ( Q, U, R1_1, R1_2, R2_1, R2_2, SType2 ) !!!!!!!!!!!!!!!! + real*8, intent(inout) :: Q, U + real*8, dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 + integer*4, intent(in) :: SType2 !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, DR - real(c_double) :: H, cosA, D1, D2, L1, L2, cosA2, t, W, Qa, Ua, Qb, Ub - integer(c_int) :: GeomID, SwitchID, IntSigna, IntSignb + real*8, dimension(0:2) :: R1, R2, Laxis1, Laxis2, F1, F2, L12, DR + real*8 :: H, cosA, D1, D2, L1, L2, cosA2, t, W, Qa, Ua, Qb, Ub + integer*4 :: GeomID, SwitchID, IntSigna, IntSignb !------------------------------------------------------------------------------------------- R1 = 0.5d+00 * ( R1_1 + R1_2 ) R2 = 0.5d+00 * ( R2_1 + R2_2 ) @@ -1584,17 +1574,17 @@ contains !********************************************************************** end if end function TPMInteractionU !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPMInteractionFNum ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2, Stype2, Delta ) - real(c_double), intent(inout) :: Q, U - real(c_double), dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2 - real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 - integer(c_int), intent(in) :: SType2 - real(c_double), intent(in) :: Delta + integer*4 function TPMInteractionFNum ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2, Stype2, Delta ) + 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) :: SType2 + real*8, intent(in) :: Delta !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j, IntSign - real(c_double) :: QQ, DD, D2 - real(c_double), dimension(0:1,0:2) :: U1_1, U1_2, U2_1, U2_2 - real(c_double), dimension(0:2) :: RR + integer*4 :: i, j, IntSign + real*8 :: QQ, DD, D2 + real*8, dimension(0:1,0:2) :: U1_1, U1_2, U2_1, U2_2 + real*8, dimension(0:2) :: RR !------------------------------------------------------------------------------------------- U = 0.0d+00 F1_1 = 0.0d+00 @@ -1635,14 +1625,15 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- subroutine TPMInit ( ChiIndM, ChiIndN ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int), intent(in) :: ChiIndM, ChiIndN - real(c_double) :: RT, DX + integer*4, intent(in) :: ChiIndM, ChiIndN + real*8 :: RT, DX + character*512 :: PDate !------------------------------------------------------------------------------------------- TPPotType = TP_POT_MONO_R ! Here we calculate the radius of nanotubes RT = TPBAcc * sqrt ( 3.0d+00 * ( ChiIndM * ChiIndM + ChiIndN * ChiIndN + ChiIndM * ChiIndN ) ) / M_2PI; - !print *, '(a,i3,a,i3,a,e18.10,a)', 'TPM is iniatized for (', ChiIndM, ',', ChiIndN, ') CNTs, RT = ', RT, ' A' + print *, '(a,i3,a,i3,a,e18.10,a)', 'TPM is iniatized for (', ChiIndM, ',', ChiIndN, ') CNTs, RT = ', RT, ' A' TPMChiIndM = ChiIndM TPMChiIndN = ChiIndN @@ -1661,6 +1652,19 @@ contains !********************************************************************** TPMASMax = 1.0d+00 - TPGeomPrec TPMASDelta = TPMASMax - TPMASMin + if ( TPMStartMode == 1 ) then + TPMUnitID = OpenFile ( TPMFile, 'rt', '' ) + read ( unit = TPMUnitID, fmt = '()' ) + read ( unit = TPMUnitID, fmt = '()' ) + read ( unit = TPMUnitID, fmt = '()' ) + else + TPMUnitID = OpenFile ( TPMFile, 'wt', '' ) + call fdate( PDate ) + write ( unit = TPMUnitID, fmt = '(a,a)' ) 'DATE ', PDate + write ( unit = TPMUnitID, fmt = '(a,i3,a,i3,a)' ) 'Tabulated data of the tubular potential for (', ChiIndM, ',', ChiIndN, ') CNTs' + write ( unit = TPMUnitID, fmt = '(a)' ) 'A. N. Volkov, L. V. Zhigilei, J. Phys. Chem. C 114, 5513-5531, 2010. doi: 10.1021/jp906142h' + end if + call TPMSSTPInit () call TPMSTPInit () @@ -1669,6 +1673,8 @@ contains !********************************************************************** call TPMAInit ( - DX, DX, - DX, DX ) call TPMSTInit () + + call CloseFile ( TPMUnitID ) end subroutine TPMInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/tools/mesont/TubePotTrue.f90 b/tools/mesont/TMDPotGen/TubePotTrue.f90 similarity index 75% rename from tools/mesont/TubePotTrue.f90 rename to tools/mesont/TMDPotGen/TubePotTrue.f90 index c43e194635..eebe65a262 100644 --- a/tools/mesont/TubePotTrue.f90 +++ b/tools/mesont/TMDPotGen/TubePotTrue.f90 @@ -1,27 +1,6 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - module TubePotTrue !******************************************************************************** ! -! TMD Library: True tubular potential and transfer function -! -!--------------------------------------------------------------------------------------------------- -! -! Intel Fortran -! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017 +! True tubular potential and transfer function ! !--------------------------------------------------------------------------------------------------- ! @@ -29,33 +8,39 @@ module TubePotTrue !************************************************************ ! between two cylinder segments of nanotubes by direct integration over the surfaces of both ! segments. ! +!--------------------------------------------------------------------------------------------------- +! +! Intel Fortran +! +! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 13.00, 2020 +! !*************************************************************************************************** use TPMGeom use TubePotBase -use iso_c_binding, only : c_int, c_double, c_char + implicit none !--------------------------------------------------------------------------------------------------- ! Constants !--------------------------------------------------------------------------------------------------- - integer(c_int), parameter :: TPTNXMAX = 257 - integer(c_int), parameter :: TPTNEMAX = 128 + integer*4, parameter :: TPTNXMAX = 257 + integer*4, parameter :: TPTNEMAX = 128 !--------------------------------------------------------------------------------------------------- ! Types !--------------------------------------------------------------------------------------------------- type TPTSEG !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double) :: X, Y, Z - real(c_double) :: Psi, Theta, Phi ! Euler's angles - real(c_double) :: R ! Segment radius - real(c_double) :: L ! Segment length - integer(c_int) :: NX, NE ! Number of nodes for numerical integration - real(c_double) :: DX, DE ! Spacings - real(c_double), dimension(0:2,0:2) :: M ! Transformation matrix - real(c_double), dimension(0:TPTNXMAX-1,0:TPTNXMAX-1,0:2) :: Rtab! Node coordinates + real*8 :: X, Y, Z + real*8 :: Psi, Theta, Phi ! Euler's angles + real*8 :: R ! Segment radius + real*8 :: L ! Segment length + integer*4 :: NX, NE ! Number of nodes for numerical integration + real*8 :: DX, DE ! Spacings + real*8, dimension(0:2,0:2) :: M ! Transformation matrix + real*8, dimension(0:TPTNXMAX-1,0:TPTNXMAX-1,0:2) :: Rtab! Node coordinates end type TPTSEG !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !--------------------------------------------------------------------------------------------------- @@ -68,17 +53,17 @@ contains !********************************************************************** subroutine TPTSegAxisVector ( S, Laxis ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(in) :: S - real(c_double), dimension(0:2), intent(out) :: Laxis + real*8, dimension(0:2), intent(out) :: Laxis !------------------------------------------------------------------------------------------- Laxis(0:2) = S%M(2,0:2) end subroutine TPTSegAxisVector !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPTSegRadVector ( S, Lrad, Eps ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(in) :: S - real(c_double), dimension(0:2), intent(out) :: Lrad - real(c_double), intent(in) :: Eps + real*8, dimension(0:2), intent(out) :: Lrad + real*8, intent(in) :: Eps !------------------------------------------------------------------------------------------- - real(c_double) :: Ce, Se + real*8 :: Ce, Se !------------------------------------------------------------------------------------------- Ce = cos ( Eps ) Se = sin ( Eps ) @@ -89,10 +74,10 @@ contains !********************************************************************** subroutine TPTRadiusVector ( S, R, X, Eps ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(in) :: S - real(c_double), dimension(0:2), intent(out) :: R - real(c_double), intent(in) :: X, Eps + real*8, dimension(0:2), intent(out) :: R + real*8, intent(in) :: X, Eps !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: Laxis, Lrad + real*8, dimension(0:2) :: Laxis, Lrad !------------------------------------------------------------------------------------------- call TPTSegAxisVector ( S, Laxis ) call TPTSegRadVector ( S, Lrad, Eps ) @@ -104,8 +89,8 @@ contains !********************************************************************** subroutine TPTCalcSegNodeTable ( S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(inout) :: S !------------------------------------------------------------------------------------------- - real(c_double) :: X, Eps - integer(c_int) :: i, j + real*8 :: X, Eps + integer*4 :: i, j !------------------------------------------------------------------------------------------- X = - S%L / 2.0 call RotationMatrix3 ( S%M, S%Psi, S%Theta, S%Phi ) @@ -121,8 +106,8 @@ contains !********************************************************************** subroutine TPTSetSegPosition1 ( S, Rcenter, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(inout) :: S - real(c_double), dimension(0:2), intent(in) :: Rcenter, Laxis - real(c_double), intent(in) :: L + real*8, dimension(0:2), intent(in) :: Rcenter, Laxis + real*8, intent(in) :: L !------------------------------------------------------------------------------------------- S%L = L S%DX = L / ( S%NX - 1 ) @@ -136,10 +121,10 @@ contains !********************************************************************** subroutine TPTSetSegPosition2 ( S, R1, R2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(inout) :: S - real(c_double), dimension(0:2), intent(in) :: R1, R2 + real*8, dimension(0:2), intent(in) :: R1, R2 !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: R, Laxis - real(c_double) :: L + real*8, dimension(0:2) :: R, Laxis + real*8 :: L !------------------------------------------------------------------------------------------- R = 0.5 * ( R1 + R2 ) Laxis = R2 - R1 @@ -148,12 +133,12 @@ contains !********************************************************************** call TPTSetSegPosition1 ( S, R, Laxis, L ) end subroutine TPTSetSegPosition2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPTCheckIntersection ( S1, S2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(in) :: S1, S2 !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j - real(c_double) :: L1, L2, Displacement, D - real(c_double), dimension(0:2) :: Laxis, Q, R + integer*4 :: i, j + real*8 :: L1, L2, Displacement, D + real*8, dimension(0:2) :: Laxis, Q, R !------------------------------------------------------------------------------------------- L2 = S1%L / 2.0 L1 = - L2 @@ -164,7 +149,8 @@ contains !********************************************************************** do i = 0, S2%NX - 1 do j = 0, S2%NE - 1 call LinePoint ( Displacement, Q, R, Laxis, S2%Rtab(i,j,0:2) ) - D = sqrt ( sqr ( Q(0) - S2%Rtab(i,j,0) ) + sqr ( Q(1) - S2%Rtab(i,j,1) ) + sqr ( Q(2) - S2%Rtab(i,j,2) ) ) + D = sqrt ( sqr ( Q(0) - S2%Rtab(i,j,0) ) + sqr ( Q(1) - S2%Rtab(i,j,1) ) & + + sqr ( Q(2) - S2%Rtab(i,j,2) ) ) if ( Displacement > L1 .and. Displacement < L2 .and. D < S1%R ) then TPTCheckIntersection = 1 return @@ -174,13 +160,13 @@ contains !********************************************************************** TPTCheckIntersection = 0 end function TPTCheckIntersection !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPTCalcPointRange ( S, Xmin, Xmax, Re ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(TPTSEG), intent(in) :: S - real(c_double), intent(out) :: Xmin, Xmax - real(c_double), dimension(0:2), intent(in) :: Re + real*8, intent(out) :: Xmin, Xmax + real*8, dimension(0:2), intent(in) :: Re !------------------------------------------------------------------------------------------- - real(c_double) :: Displacement, Distance - real(c_double), dimension(0:2) :: Laxis, Q, R + real*8 :: Displacement, Distance + real*8, dimension(0:2) :: Laxis, Q, R !------------------------------------------------------------------------------------------- call TPTSegAxisVector ( S, Laxis ) R(0) = S%X @@ -201,8 +187,8 @@ contains !********************************************************************** end function TPTCalcPointRange !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine TPTGetEnds ( R1_1, R1_2, R2_1, R2_2, X1_1, X1_2, X2_1, X2_2, H, A ) !!!!!!!!!!!!! - real(c_double), dimension(0:2), intent(out) :: R1_1, R1_2, R2_1, R2_2 - real(c_double), intent(in) :: X1_1, X1_2, X2_1, X2_2, H, A + real*8, dimension(0:2), intent(out) :: R1_1, R1_2, R2_1, R2_2 + real*8, intent(in) :: X1_1, X1_2, X2_1, X2_2, H, A !------------------------------------------------------------------------------------------- R1_1(0) = 0.0d+00 R1_1(1) = 0.0d+00 @@ -222,19 +208,19 @@ contains !********************************************************************** ! Tubular potential !--------------------------------------------------------------------------------------------------- - integer(c_int) function TPTPointPotential ( Q, U, F, R, S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPTPointPotential ( Q, U, F, R, S ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the potential U and force F applied to the atom in position R and ! produced by the segment S. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), dimension(0:2), intent(out) :: F - real(c_double), dimension(0:2), intent(in) :: R + real*8, intent(out) :: Q, U + real*8, dimension(0:2), intent(out) :: F + real*8, dimension(0:2), intent(in) :: R type(TPTSEG), intent(in) :: S !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j - real(c_double), dimension(0:2) :: RR, FF - real(c_double) :: QQ, UU, UUU, FFF, Rabs - real(c_double) :: Coeff, Xmin, Xmax, X + integer*4 :: i, j + real*8, dimension(0:2) :: RR, FF + real*8 :: QQ, UU, UUU, FFF, Rabs + real*8 :: Coeff, Xmin, Xmax, X !------------------------------------------------------------------------------------------- TPTPointPotential = 0 Q = 0.0d+00 @@ -277,19 +263,19 @@ contains !********************************************************************** F = F * Coeff end function TPTPointPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTSectionPotential ( Q, U, F, M, S, i, Ssource ) !!!!!!!!!!!!!!!!!!!!!!! - ! This funcion returns the potential U, force F and torque M produced by the segment Ssource + integer*4 function TPTSectionPotential ( Q, U, F, M, S, i, Ssource ) !!!!!!!!!!!!!!!!!!!!!!! + ! This function returns the potential U, force F and torque M produced by the segment Ssource ! and applied to the i-th circular cross-section of the segment S. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), dimension(0:2), intent(out) :: F, M + real*8, intent(out) :: Q, U + real*8, dimension(0:2), intent(out) :: F, M type(TPTSEG), intent(in) :: S, Ssource - integer(c_int), intent(in) :: i + integer*4, intent(in) :: i !------------------------------------------------------------------------------------------- - integer(c_int) :: j - real(c_double), dimension(0:2) :: R, Fp, Mp, Lrad - real(c_double) :: Qp, Up, Eps - real(c_double) :: Coeff + integer*4 :: j + real*8, dimension(0:2) :: R, Fp, Mp, Lrad + real*8 :: Qp, Up, Eps + real*8 :: Coeff !------------------------------------------------------------------------------------------- TPTSectionPotential = 0 Q = 0.0d+00 @@ -319,16 +305,16 @@ contains !********************************************************************** M = M * Coeff end function TPTSectionPotential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTSegmentPotential ( Q, U, F, M, S, Ssource ) !!!!!!!!!!!!!!!!!!!!!!!!!! + integer*4 function TPTSegmentPotential ( Q, U, F, M, S, Ssource ) !!!!!!!!!!!!!!!!!!!!!!!!!! ! This function returns the potential U, force F and torque M produced by the segment ! Ssource and applied to the segment S. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), dimension(0:2), intent(out) :: F, M + real*8, intent(out) :: Q, U + real*8, dimension(0:2), intent(out) :: F, M type(TPTSEG), intent(in) :: S, Ssource - integer(c_int) :: i - real(c_double), dimension(0:2) :: Fc, Mc - real(c_double) :: Qc, Uc + integer*4 :: i + real*8, dimension(0:2) :: Fc, Mc + real*8 :: Qc, Uc !------------------------------------------------------------------------------------------- TPTSegmentPotential = 0 Q = 0.0d+00 @@ -366,11 +352,11 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- subroutine TPTSegmentForces ( F1, F2, F, M, Laxis, L ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), dimension(0:2), intent(out) :: F1, F2 - real(c_double), dimension(0:2), intent(in) :: F, M, Laxis - real(c_double), intent(in) :: L + real*8, dimension(0:2), intent(out) :: F1, F2 + real*8, dimension(0:2), intent(in) :: F, M, Laxis + real*8, intent(in) :: L !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: MM, FF, FFF + real*8, dimension(0:2) :: MM, FF, FFF !------------------------------------------------------------------------------------------- FF = 0.5d+00 * F MM = M / L @@ -379,15 +365,15 @@ contains !********************************************************************** F2 = FF + FFF end subroutine TPTSegmentForces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - integer(c_int) function TPTInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2 ) - ! This function returns the potential and forces appliend to the ends of segments. + integer*4 function TPTInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2 ) + ! This function returns the potential and forces applied to the ends of segments. !------------------------------------------------------------------------------------------- - real(c_double), intent(out) :: Q, U - real(c_double), dimension(0:2), intent(out) :: F1_1, F1_2, F2_1, F2_2 - real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 + real*8, intent(out) :: Q, U + real*8, dimension(0:2), intent(out) :: F1_1, F1_2, F2_1, F2_2 + real*8, dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: R1, R2, Laxis1, Laxis2, DR, F1, M1, F2, M2 - real(c_double) :: L1, L2 + real*8, dimension(0:2) :: R1, R2, Laxis1, Laxis2, DR, F1, M1, F2, M2 + real*8 :: L1, L2 !------------------------------------------------------------------------------------------- R1 = 0.5 * ( R1_1 + R1_2 ) R2 = 0.5 * ( R2_1 + R2_2 ) @@ -414,8 +400,8 @@ contains !********************************************************************** !--------------------------------------------------------------------------------------------------- subroutine TPTInit ( R1, R2, NX, NE ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(in) :: R1, R2 - integer(c_int), intent(in) :: NX, NE + real*8, intent(in) :: R1, R2 + integer*4, intent(in) :: NX, NE !------------------------------------------------------------------------------------------- TPTSeg1%X = 0.0d+00 TPTSeg1%Y = 0.0d+00 @@ -439,4 +425,4 @@ contains !********************************************************************** TPTSeg2%DE = M_2PI / NE end subroutine TPTInit !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -end module TubePotTrue !**************************************************************************** +end module TubePotTrue !**************************************************************************** \ No newline at end of file diff --git a/tools/mesont/TPMForceField.f90 b/tools/mesont/TPMForceField.f90 deleted file mode 100644 index b53b2ee7d8..0000000000 --- a/tools/mesont/TPMForceField.f90 +++ /dev/null @@ -1,290 +0,0 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - -module TPMForceField !************************************************************************************ -! -! TMD Library: Calculation of the TMD force field -! -!--------------------------------------------------------------------------------------------------- -! -! PGI Fortran, Intel Fortran -! -! Alexey N. Volkov, University of Alabama (avolkov1@ua.edu), Version 09.01.33, 2018 -! -!*************************************************************************************************** - -use CNTPot -use TPMM0 -use TPMM1 -use iso_c_binding, only : c_int, c_double, c_char -implicit none - -contains !****************************************************************************************** - - subroutine TubeStretchingForceField ( U1, U2, F1, F2, S1, S2, X1, X2, R12, L12 ) !!!!!!!!!!! - real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor - real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes - real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in) :: L12 ! Equilubrium length of segment (X1,X2) - !------------------------------------------------------------------------------------------- - integer(c_int) :: ii, jj, Event - real(c_double) :: U, F, LL, S, Ubcl - real(c_double), dimension(0:2) :: DX, FF - !------------------------------------------------------------------------------------------- - DX = X2 - X1 - LL = S_V3norm3 ( DX ) - Event = CNTSTRCalc ( U, F, LL, R12, L12, 0, Ubcl ) - - U = U / 2.0d+00 - FF = DX * F / LL - - F1 = F1 + FF - U1 = U1 + U - - F2 = F2 - FF - U2 = U2 + U - - ! Stress - do ii = 0, 2 - do jj = 0, 2 - S = - 0.5d+00 * DX(ii) * FF(jj) - S1(ii,jj) = S1(ii,jj) + S - S2(ii,jj) = S2(ii,jj) + S - end do - end do - end subroutine TubeStretchingForceField !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine TubeBendingForceField ( U1, U2, U3, F1, F2, F3, S1, S2, S3, X1, X2, X3, R123, L123, BBF2 ) - real(c_double), intent(inout) :: U1, U2, U3 ! Interaction energies associated with nodes X1, X2, and X3 - real(c_double), intent(inout), dimension(0:2) :: F1, F2, F3 ! Forces exerted on nodes X1, X2, and X3 - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2, S3 ! Contributions of nodes X1, X2, and X3 to the virial stress tensor - real(c_double), intent(in), dimension(0:2) :: X1, X2, X3 ! Coordinates of nodes - real(c_double), intent(in) :: R123 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in) :: L123 ! Equilubrium length of segment (X1,X2) and (X2,X3) (It is assumed to be the same for both segments) - integer(c_int), intent(inout) :: BBF2 - !------------------------------------------------------------------------------------------- - integer(c_int) :: ii, jj, Event - real(c_double) :: U, F, K, S, Ubcl - real(c_double), dimension(0:2) :: G0, G1, G2 - !------------------------------------------------------------------------------------------- - call BendingGradients ( K, G0, G1, G2, X1, X2, X3 ) - Event = CNTBNDCalc ( U, F, K, R123, L123, BBF2, Ubcl ) - - if ( Event == CNTPOT_BBUCKLING ) then - BBF2 = 1 - else - BBF2 = 0 - end if - - U = U / 4.0d+00 - F = - F - - F1 = F1 + G0 * F - F2 = F2 + G1 * F - F3 = F3 + G2 * F - - U1 = U1 + U - U2 = U2 + 2.0d+00 * U - U3 = U3 + U - - ! Stress - do ii = 0, 2 - do jj = 0, 2 - S = 0.5d+00 * ( X1(ii) - X2(ii) ) * G0(jj) - S1(ii,jj) = S1(ii,jj) + S - S2(ii,jj) = S2(ii,jj) + S - S = 0.5d+00 * ( X3(ii) - X2(ii) ) * G2(jj) - S3(ii,jj) = S3(ii,jj) + S - S2(ii,jj) = S2(ii,jj) + S - end do - end do - end subroutine TubeBendingForceField !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! The purpose of subroutine SegmentTubeForceField is to calculate interaction forces - ! (as well potential nergies and componets of the virial stress tensor) between a segment - ! (X1,X2) and a sequence of segments with node coordinates that belongs to a single CNT - - ! It is assumed that X contains ALL nodes of a single CNT that are included into the - ! neighbor list of segment (X1,X2) - - ! The nodes in X are assumed to be ordered according to their physical appearence in the nanotube - ! It means that (X(i),X(i+1)) are either correspond to a real segment or divided by a segments - ! that do not belong to a nanotube. - - ! Concept of the extendend chain: - ! Let's consider a sequant of nodes (X1,X2,...,XN) forming continuous part of a nanotube. - ! If node Xe preceeds X1 and Xe is the nanotube end, then the extended chain is (Xe,X1,...,XN) and Ee = 1. - ! If node Xe follows XN and Xe is the nanotube end, then the extended chain is (X1,...,XN,Xe) and Ee = 2. - ! In all other cases, extended chain coincides with (X1,...,XN) and Ee = 0 - ! If the extended chain contains additional node, then non-zero force is exterted on this node - - subroutine SegmentTubeForceField ( U1, U2, U, F1, F2, F, Fe, S1, S2, S, Se, X1, X2, R12, N, X, Xe, BBF, R, E1, E2, Ee, TPMType ) - integer(c_int), intent(in) :: N ! Number of nodes in array X - real(c_double), intent(inout) :: U1, U2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), intent(inout), dimension(0:N-1) :: U ! Interaction energies associated with nodes X - real(c_double), intent(inout), dimension(0:2) :: F1, F2 ! Forces exerted on nodes X1 and X2 - real(c_double), intent(inout), dimension(0:2,0:N-1) :: F ! Forces exerted on nodes X - real(c_double), intent(inout), dimension(0:2) :: Fe ! Force exerted on node Xe (can be updated only if Ee > 0) - real(c_double), intent(inout), dimension(0:2,0:2) :: S1, S2 ! Contributions of nodes X1 and X2 to the virial stress tensor - real(c_double), intent(inout), dimension(0:2,0:2,0:N-1) :: S ! Contributions of nodes X to the virial stress tensor - real(c_double), intent(inout), dimension(0:2,0:2) :: Se ! Contributions of node Xe to the virial stress tensor (can be updated only if Ee > 0) - real(c_double), intent(in), dimension(0:2) :: X1, X2 ! Coordinates of the segmnet nodes - real(c_double), intent(in) :: R12 ! Radius of nanotube the segment (X1,X2) belongs to - real(c_double), intent(in), dimension(0:2,0:N-1) :: X ! Coordinates of the nanotube nodes - real(c_double), intent(in), dimension(0:2) :: Xe ! Additiona node of the extended chain if Ee > 0 - integer(c_int), intent(in), dimension(0:N-1) :: BBF ! Bending buckling flags (BBF(i) = 1 in a case of buckling in node i) - real(c_double), intent(in) :: R ! Radius of nanotube X - integer(c_int), intent(in) :: E1, E2 ! E1 = 1 if the chnane node 0 is a CNT end; E1 = 2 if the chnane node N-1 is a CNT end; - integer(c_int), intent(in) :: Ee ! Parameter defining the type of the extended chain (0,1,2) - integer(c_int), intent(in) :: TPMType ! Type of the tubular potential (0 or 1) - !------------------------------------------------------------------------------------------- - integer(c_int) :: k, ii, jj, IntSign - integer(c_int) :: BType, EType, LocalTPMType - real(c_double), dimension(0:2,0:N-1) :: G1, G2 - real(c_double), dimension(0:N-1) :: QQ - logical :: EType1, EType2 - real(c_double), dimension(0:2) :: G, DG, DQ, XX - real(c_double) :: UT, DR, DS, DS1 - real(c_double) :: xU1, xU2 ! Interaction energies associated with nodes X1 and X2 - real(c_double), dimension(0:N-1) :: xU ! Interaction energies associated with nodes X - real(c_double), dimension(0:2) :: xF1, xF2 ! Forces exerted on nodes X1 and X2 - real(c_double), dimension(0:2,0:N-1) :: xF ! Forces exerted on nodes X - real(c_double), dimension(0:2) :: xFe ! Force exerted on node Xe (can be updated only if Ee > 0) - !------------------------------------------------------------------------------------------- - - !U1 = 0.0d+00 - !U2 = 0.0d+00 - !U = 0.0d+00 - !F1 = 0.0d+00 - !F2 = 0.0d+00 - !F = 0.0d+00 - !S1 = 0.0d+00 - !S2 = 0.0d+00 - !S = 0.0d+00 - - ! Looking for a buckling point - BType = 0 - do k = 0, N - 1 - if ( BBF(k) == 1 ) then - BType = 1 - exit - end if - end do - - ! Choosing the LocalTPMType and Etype. - ! LocalTPMType is set to 0 if both ends of the chain are nanotube ends or the chain contains a buckling point. - ! Overwise, LocalTPMType = TPMType. - if ( BType == 1 ) then - LocalTPMType = 0 - EType = 0 - else - if ( E1 == 1 ) then ! First node in the chain is the tube end - EType1 = .true. - else - EType1 = .false. - end if - if ( E2 == 1 ) then ! Last node in the chain is the tube end - EType2 = .true. - else - EType2 = .false. - end if - if ( EType1 .and. EType2 ) then - LocalTPMType = 0 - else - LocalTPMType = TPMType - if ( EType1 ) then - EType = 1 - else if ( EType2 ) then - EType = 2 - else ! No tube ends in the chain - EType = 0 - end if - end if - end if - - if ( LocalTPMType == 0 ) then - IntSign = TPMInteractionFW0 ( QQ, UT, xU1, xU2, xU, xF1, xF2, xF, G1, G2, X1, X2, N, N, X ) - else - if ( EType == 0 ) then - if ( Ee == 1 ) then ! First node in the extended chain is the tube end - EType = 3 - else if ( Ee == 2 ) then ! Last node in the extended chain is the tube end - EType = 4 - end if - end if - IntSign = TPMInteractionFW1 ( QQ, UT, xU1, xU2, xU, xF1, xF2, xF, xFe, G1, G2, X1, X2, N, N, X, Xe, EType ) - end if - if ( IntSign == 0 ) return ! No interaction - - ! Final potential energies - U1 = U1 + 0.5d+00 * xU1 - U2 = U2 + 0.5d+00 * xU2 - U(0:N-1) = U(0:N-1) + 0.5d+00 * xU(0:N-1) - - ! Contributions to the virial stresses tensor - do ii = 0, 2 - DR = 0.125d+00 * ( X2(ii) - X1(ii) ) - do jj = 0, 2 - DS = DR * ( xF2(jj) - xF1(jj) ) - S1(ii,jj) = S1(ii,jj) + DS - S2(ii,jj) = S2(ii,jj) + DS - end do - end do - XX = 0.5d+00 * ( X2 + X1 ) - if ( EType > 2 ) then - DQ = Xe - XX - call ApplyPeriodicBC ( DQ ) - DQ = DQ / 6.0d+00 - do ii = 0, 2 - do jj = 0, 2 - DS = DQ(ii) * xFe(jj) - S1(ii,jj) = S1(ii,jj) + DS - S2(ii,jj) = S1(ii,jj) + DS - Se(ii,jj) = Se(ii,jj) + DS - end do - end do - end if - do k = 0, N - 2 - DQ = 0.5d+00 * ( X(0:2,k+1) + X(0:2,k) ) - XX - call ApplyPeriodicBC ( DQ ) - DQ = 0.125d+00 * DQ - G = G1(0:2,k+1) + G2(0:2,k) - DG = G1(0:2,k+1) - G2(0:2,k) - do ii = 0, 2 - DR = 0.125d+00 * ( X(ii,k+1) - X(ii,k) ) - do jj = 0, 2 - DS = DQ(ii) * G(jj) - DS1 = DS + DR * DG(jj) - S1(ii,jj) = S1(ii,jj) + DS - S2(ii,jj) = S2(ii,jj) + DS - S(ii,jj,k) = S(ii,jj,k) + DS1 - S(ii,jj,k+1) = S(ii,jj,k+1) + DS1 - end do - end do - end do - - ! Final forces - F1 = F1 + 0.5d+00 * xF1 - F2 = F2 + 0.5d+00 * xF2 - F(0:2,0:N-1) = F(0:2,0:N-1) + 0.5d+00 * xF(0:2,0:N-1) - if ( EType > 2 ) then - Fe = Fe + 0.5d+00 * xFe - end if - - end subroutine SegmentTubeForceField !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -end module TPMForceField !************************************************************************** diff --git a/tools/mesont/TPMM0.f90 b/tools/mesont/TPMM0.f90 deleted file mode 100644 index 659855f049..0000000000 --- a/tools/mesont/TPMM0.f90 +++ /dev/null @@ -1,195 +0,0 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - -module TPMM0 !************************************************************************************** -! -! TMD Library: Combined/Weighted potential of type 0 -! -! Direct application of SST potential to calculation of segment-segment interaction -! -!--------------------------------------------------------------------------------------------------- -! -! Intel Fortran -! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017 -! -!*************************************************************************************************** - -!use TMDCounters -use TubePotMono -use iso_c_binding, only : c_int, c_double, c_char -implicit none - -contains !****************************************************************************************** - - integer(c_int) function TPMInteractionFSS ( Q, U, F1_1, F1_2, F2_1, F2_2, R1_1, R1_2, R2_1, R2_2, EType ) - real(c_double), intent(inout) :: Q, U - real(c_double), dimension(0:2), intent(inout) :: F1_1, F1_2, F2_1, F2_2 - real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 - integer(c_int), intent(in) :: EType - !------------------------------------------------------------------------------------------- - real(c_double) :: Qa, Ua, Fd, L2 - real(c_double), dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a, R2_3, R2, Laxis2, F - integer(c_int) :: IntSign - !------------------------------------------------------------------------------------------- -! C_TPM_4 = C_TPM_4 + 1 - R2 = 0.5d+00 * ( R2_1 + R2_2 ) - Laxis2 = R2_2 - R2_1 - L2 = S_V3norm3 ( Laxis2 ) - Laxis2 = Laxis2 / L2 - if ( EType < 2 ) then - TPMInteractionFSS = TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, 1 ) - R2_3 = R2_2 + R2_2 - R2_1 - IntSign = TPMInteractionF ( Qa, Ua, F1_1a, F1_2a, F2_1a, F2_2a, Fd, R1_1, R1_2, R2_2, R2_3, 1 ) - if ( IntSign > 0 ) then - TPMInteractionFSS = 1 - call TPMSegmentForces ( F2_1a, F2_2a, F1_1a, F1_2a, R1_1, R1_2, R2, Laxis2, L2 ) - F = ( Fd - S_V3xV3 ( F2_2a, Laxis2 ) ) * Laxis2 - F2_2a = F2_2a + F - F2_1a = F2_1a - F - end if - else - TPMInteractionFSS = TPMInteractionF ( Q, U, F1_1, F1_2, F2_1, F2_2, Fd, R1_1, R1_2, R2_1, R2_2, 2 ) - R2_3 = R2_1 + R2_1 - R2_2 - IntSign = TPMInteractionF ( Qa, Ua, F1_1a, F1_2a, F2_1a, F2_2a, Fd, R1_1, R1_2, R2_1, R2_3, 1 ) - if ( IntSign > 0 ) then - TPMInteractionFSS = 1 - call TPMSegmentForces ( F2_1a, F2_2a, F1_1a, F1_2a, R1_1, R1_2, R2, Laxis2, L2 ) - F = ( - Fd - S_V3xV3 ( F2_1a, Laxis2 ) ) * Laxis2 - F2_1a = F2_1a + F - F2_2a = F2_2a - F - end if - end if - if ( IntSign > 0 ) then - Q = Q - Qa - if ( Q < 0.0d+00 ) Q = 0.0d+00 - U = U - Ua - F2_1 = F2_1 - F2_1a - F2_2 = F2_2 - F2_2a - F1_1 = F1_1 - F1_1a - F1_2 = F1_2 - F1_2a - end if - end function TPMInteractionFSS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function TPMInteractionFW0 ( QQ, U, U1, U2, UU, F1, F2, F, G1, G2, R1, R2, N, NMAX, R ) - real(c_double), intent(inout) :: U, U1, U2 - integer(c_int), intent(in) :: N, NMAX - real(c_double), dimension(0:NMAX-1), intent(out) :: QQ, UU - real(c_double), dimension(0:2), intent(out) :: F1, F2 - real(c_double), dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2 - real(c_double), dimension(0:2), intent(in) :: R1, R2 - real(c_double), dimension(0:2,0:NMAX-1), intent(in) :: R - !------------------------------------------------------------------------------------------- - integer(c_int) :: i, SType2, GeomID, EType - real(c_double) :: Ua - real(c_double), dimension(0:2) :: F1_1a, F1_2a, F2_1a, F2_2a - real(c_double), dimension(0:2) :: R1a, R2a, Laxis1, Laxis2, L12, DR - real(c_double) :: L1, L2, D1, D2, H, cosA, D, Dmina, Dminb - !------------------------------------------------------------------------------------------- - QQ = 0.0d+00 - U = 0.0d+00 - U1 = 0.0d+00 - U2 = 0.0d+00 - UU = 0.0d+00 - F1 = 0.0d+00 - F2 = 0.0d+00 - F = 0.0d+00 - G1 = 0.0d+00 - G2 = 0.0d+00 - TPMInteractionFW0 = 0 - do i = 0, N - 2 - R1a = 0.5d+00 * ( R1 + R2 ) - R2a = 0.5d+00 * ( R(0:2,i+1) + R(0:2,i) ) - Laxis1 = R2 - R1 - Laxis2 = R(0:2,i+1) - R(0:2,i) - L1 = S_V3norm3 ( Laxis1 ) - L2 = S_V3norm3 ( Laxis2 ) - Laxis1 = Laxis1 / L1 - Laxis2 = Laxis2 / L2 - L2 = 0.5d+00 * L2 - L1 = 0.5d+00 * L1 - GeomID = LineLine ( H, cosA, D1, D2, L12, R1a, Laxis1, R2a, Laxis2, TPGeomPrec ) - - DR = R1 - R(0:2,i) - call ApplyPeriodicBC ( DR ) - Dmina = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) ) - DR = R2 - R(0:2,i) - call ApplyPeriodicBC ( DR ) - D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) ) - if ( D < Dmina ) Dmina = D - if ( GeomID == MD_LINES_NONPAR ) then - D = ( D2 - L2 ) * cosA - if ( D > D1 - L1 .and. D < D1 + L1 ) then - D = sqr ( D2 - L2 ) * ( 1.0d+00 - sqr ( cosA ) ) + sqr ( H ) - if ( D < Dmina ) Dmina = D - end if - else - call LinePoint ( D, DR, R1, Laxis1, R(0:2,i) ) - if ( D > 0.0d+00 .and. D < 2.0d+00 * L1 ) then - DR = DR - R(0:2,i) - call ApplyPeriodicBC ( DR ) - D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) ) - if ( D < Dmina ) Dmina = D - end if - end if - - DR = R1 - R(0:2,i+1) - call ApplyPeriodicBC ( DR ) - Dminb = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) ) - DR = R2 - R(0:2,i+1) - call ApplyPeriodicBC ( DR ) - D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) ) - if ( D < Dminb ) Dminb = D - if ( GeomID == MD_LINES_NONPAR ) then - D = ( D2 + L2 ) * cosA - if ( D > D1 - L1 .and. D < D1 + L1 ) then - D = sqr ( D2 + L2 ) * ( 1.0d+00 - sqr ( cosA ) ) + sqr ( H ) - if ( D < Dminb ) Dminb = D - end if - else - call LinePoint ( D, DR, R1, Laxis1, R(0:2,i+1) ) - if ( D > 0.0d+00 .and. D < 2.0d+00 * L1 ) then - DR = DR - R(0:2,i+1) - call ApplyPeriodicBC ( DR ) - D = sqr ( DR(0) ) + sqr ( DR(1) ) + sqr ( DR(2) ) - if ( D < Dminb ) Dminb = D - end if - end if - - if ( Dmina < Dminb ) then - EType = 1 - else - EType = 2 - end if - - if ( TPMInteractionFSS ( QQ(i), Ua, F1_1a, F1_2a, F2_1a, F2_2a, R1, R2, R(0:2,i), R(0:2,i+1), EType ) > 0 ) then - TPMInteractionFW0 = 1 - U = U + Ua - Ua = 0.25d+00 * Ua - U1 = U1 + Ua - U2 = U2 + Ua - UU(i) = UU(i) + Ua - UU(i+1) = UU(i+1) + Ua - F1 = F1 + F1_1a - F2 = F2 + F1_2a - F(0:2,i) = F(0:2,i) + F2_1a - F(0:2,i+1) = F(0:2,i+1) + F2_2a - G2(0:2,i) = F2_1a - G1(0:2,i+1) = F2_2a - end if - end do - end function TPMInteractionFW0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -end module TPMM0 !********************************************************************************** diff --git a/tools/mesont/TPMM1.f90 b/tools/mesont/TPMM1.f90 deleted file mode 100644 index 98784ba593..0000000000 --- a/tools/mesont/TPMM1.f90 +++ /dev/null @@ -1,379 +0,0 @@ -! ------------ ---------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! http://lammps.sandia.gov, Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -! -! Contributing author: Alexey N. Volkov, UA, avolkov1@ua.edu -!------------------------------------------------------------------------- - -module TPMM1 !************************************************************************************** -! -! TMD Library: Combined/Weighted potential of type 3 -! -! Weighting functions are the same as in potential of type 2. -! Calculation of the combined potential is based on the 'extended' chain. -! -!--------------------------------------------------------------------------------------------------- -! -! Intel Fortran. -! -! Alexey N. Volkov, University of Alabama, avolkov1@ua.edu, Version 09.01, 2017 -! -!*************************************************************************************************** - -!use TMDCounters -use TubePotMono -use iso_c_binding, only : c_int, c_double, c_char -implicit none - -!--------------------------------------------------------------------------------------------------- -! Constants -!--------------------------------------------------------------------------------------------------- - - ! Maximal length of a segment chain - integer(c_int), parameter :: TPM_MAX_CHAIN = 100 - -!--------------------------------------------------------------------------------------------------- -! Numerical parameters -!--------------------------------------------------------------------------------------------------- - - ! Switching parameters - real(c_double) :: TPMC123 = 1.0d+00 ! Non-dimensional - real(c_double) :: TPMC3 = 10.0d+00 ! (A) - -!--------------------------------------------------------------------------------------------------- -! Global variables -!--------------------------------------------------------------------------------------------------- - - ! These global variables are used to speedup calculations - real(c_double), dimension(0:2,0:TPM_MAX_CHAIN-1) :: E1, E2, EE1, EE2 - real(c_double), dimension(0:2) :: Q1, Q2, Qe, Qe1, DR, Z1, Z2, S1, S2, Pe, Pe1 - real(c_double), dimension(0:TPM_MAX_CHAIN-1) :: W, C - real(c_double), dimension(0:2) :: RR, E10 - real(c_double) :: L10, D10 - -contains !****************************************************************************************** - - subroutine PairWeight1 ( W, E1_1, E1_2, E2_1, E2_2, R2_1, R2_2 ) !!!!!!!!!!!!!!!!!!!!!!!!!!! - real(c_double), intent(out) :: W - real(c_double), dimension(0:2), intent(out) :: E1_1, E1_2, E2_1, E2_2 - real(c_double), dimension(0:2), intent(in) :: R2_1, R2_2 - !------------------------------------------------------------------------------------------- - real(c_double) :: D, L20, D20, t, dWdD - real(c_double), dimension(0:2) :: E, E20 - !------------------------------------------------------------------------------------------- - E = 0.5d+00 * ( R2_1 + R2_2 ) - RR - call ApplyPeriodicBC ( E ) - D = E(0) * E(0) + E(1) * E(1) + E(2) * E(2) - if ( D < D10 * D10 ) then - W = 1.0d+00 - E1_1 = 0.0d+00 - E1_2 = 0.0d+00 - E2_1 = 0.0d+00 - E2_2 = 0.0d+00 - return - end if - E20 = 0.5d+00 * ( R2_2 - R2_1 ) - L20 = sqrt ( S_V3xx ( E20 ) + sqr ( TPMR2 ) ) - D20 = L10 + L20 + TPBRcutoff + RSkin - if ( D > D20 * D20 ) then - W = 0.0d+00 - E1_1 = 0.0d+00 - E1_2 = 0.0d+00 - E2_1 = 0.0d+00 - E2_2 = 0.0d+00 - return - end if - D = sqrt ( D ) - E = E / D - E20 = E20 / L20 - D20 = D20 - D10 - t = ( D - D10 ) / D20 - W = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t ) - dWdD = 3.0d+00 * t * ( t - 1.0d+00 ) / D20 - E1_1 = dWdD * ( t * E10 - E ) - E1_2 = dWdD * ( - t * E10 - E ) - E2_1 = dWdD * ( E + t * E20 ) - E2_2 = dWdD * ( E - t * E20 ) - end subroutine PairWeight1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function EndWeight1 ( W, E1_1, E1_2, E2_1, E2_2, R1_1, R1_2, R2_1, R2_2 ) !!!!!!!! - real(c_double), intent(out) :: W - real(c_double), dimension(0:2), intent(out) :: E1_1, E1_2, E2_1, E2_2 - real(c_double), dimension(0:2), intent(in) :: R1_1, R1_2, R2_1, R2_2 - !------------------------------------------------------------------------------------------- - real(c_double) :: D, L20 - real(c_double) :: D1, D2, t, dWdD - real(c_double), dimension(0:2) :: RR, E, E20 - !------------------------------------------------------------------------------------------- - E = 0.5d+00 * ( R2_1 + R2_2 - ( R1_1 + R1_2 ) ) - call ApplyPeriodicBC ( E ) - D = S_V3norm3 ( E ) - E20 = 0.5d+00 * ( R2_2 - R2_1 ) - L20 = sqrt ( S_V3xx ( E20 ) + sqr ( TPMR2 ) ) - D1 = L10 + L20 + TPBRcutoff + RSkin - if ( D < D1 ) then - EndWeight1 = 0 - W = 1.0d+00 - E1_1 = 0.0d+00 - E1_2 = 0.0d+00 - E2_1 = 0.0d+00 - E2_2 = 0.0d+00 - return - end if - D2 = D1 + TPMC3 - if ( D > D2 ) then - EndWeight1 = 2 - W = 0.0d+00 - E1_1 = 0.0d+00 - E1_2 = 0.0d+00 - E2_1 = 0.0d+00 - E2_2 = 0.0d+00 - return - end if - EndWeight1 = 1 - E = E / D - E20 = E20 / L20 - t = ( D - D1 ) / TPMC3 - W = 1.0d+00 - t * t * ( 3.0d+00 - 2.0d+00 * t ) - dWdD = 3.0d+00 * t * ( t - 1.0d+00 ) / TPMC3 - E1_1 = dWdD * ( E10 - E ) - E1_2 = dWdD * ( - E10 - E ) - E2_1 = dWdD * ( E + E20 ) - E2_2 = dWdD * ( E - E20 ) - end function EndWeight1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function TPMInteractionFC1 ( Q, U, F1, F2, P1, P2, Pe, Pe1, R1, R2, Q1, Q2, Qe, Qe1, EType ) - real(c_double), intent(out) :: Q, U - real(c_double), dimension(0:2), intent(out) :: F1, F2, P1, P2, Pe, Pe1 - real(c_double), dimension(0:2), intent(in) :: R1, R2, Q1, Q2, Qe, Qe1 - integer(c_int), intent(in) :: EType - !------------------------------------------------------------------------------------------- - real(c_double), dimension(0:2) :: M, QX, Me, F1a, F2a, P1a, P2a, F1b, F2b, P1b, P2b, ER1, ER2, EQe, EQe1 - real(c_double) :: W, W1, D, Qa, Qb, Ua, Ub, L, Pee, Peea, Peeb, DU - integer(c_int) :: IntSigna, IntSignb, CaseID - !------------------------------------------------------------------------------------------- - if ( EType == 0 ) then -! C_TPM_0 = C_TPM_0 + 1 - TPMInteractionFC1 = TPMInteractionF ( Q, U, F1, F2, P1, P2, Pee, R1, R2, Q1, Q2, 0 ) - Pe = 0.0d+00 - Pe1 = 0.0d+00 - else if ( EType < 3 ) then -! C_TPM_1 = C_TPM_1 + 1 - QX = 0.5d+00 * ( Q1 + Q2 ) - M = Q2 - Q1 - L = S_V3norm3 ( M ) - M = M / L - Me = Qe - QX - D = S_V3norm3 ( Me ) - if ( EType == 1 ) then - TPMInteractionFC1 = TPMInteractionF ( Q, U, F1, F2, P1, P2, Pee, R1, R2, QX - D * M, QX, 1 ) - else - TPMInteractionFC1 = TPMInteractionF ( Q, U, F1, F2, P1, P2, Pee, R1, R2, QX, QX + D * M, 2 ) - end if - call TPMSegmentForces ( P1, P2, F1, F2, R1, R2, QX, M, L ) - Pe = ( Pee / D ) * Me - Pe1 = 0.0d+00 - QX = 0.5d+00 * Pe - P1 = P1 + QX - P2 = P2 + QX - else - CaseID = EndWeight1 ( W, ER1, ER2, EQe, Eqe1, R1, R2, Qe, Qe1 ) - if ( CaseID < 2 ) then - QX = 0.5d+00 * ( Q1 + Q2 ) - M = Q2 - Q1 - L = S_V3norm3 ( M ) - M = M / L - Me = Qe - QX - D = S_V3norm3 ( Me ) - if ( EType == 3 ) then - IntSigna = TPMInteractionF ( Qa, Ua, F1a, F2a, P1a, P2a, Peea, R1, R2, QX - D * M, QX, 1 ) - else - IntSigna = TPMInteractionF ( Qa, Ua, F1a, F2a, P1a, P2a, Peea, R1, R2, QX, QX + D * M, 2 ) - end if - call TPMSegmentForces ( P1a, P2a, F1a, F2a, R1, R2, QX, M, L ) - end if - - if ( CaseID > 0 ) then - IntSignb = TPMInteractionF ( Qb, Ub, F1b, F2b, P1b, P2b, Peeb, R1, R2, Q1, Q2, 0 ) - end if - - if ( CaseID == 0 ) then -! C_TPM_1 = C_TPM_1 + 1 - TPMInteractionFC1 = IntSigna - Q = Qa - U = Ua - F1 = F1a - F2 = F2a - Pe = ( Peea / D ) * Me - Pe1 = 0.0d+00 - QX = 0.5d+00 * Pe - P1 = P1a + QX - P2 = P2a + QX - else if ( CaseID == 2 ) then -! C_TPM_0 = C_TPM_0 + 1 - TPMInteractionFC1 = IntSignb - Q = Qb - U = Ub - F1 = F1b - F2 = F2b - P1 = P1b - P2 = P2b - Pe = 0.0d+00 - Pe1 = 0.0d+00 - else -! C_TPM_2 = C_TPM_2 + 1 - TPMInteractionFC1 = 0 - if ( IntSigna > 0 .or. IntSignb > 0 ) TPMInteractionFC1 = 1 - W1 = 1.0d+00 - W - DU = Ub - Ua - Q = W * Qa + W1 * Qb - U = W * Ua + W1 * Ub - Pe = ( W * Peea / D ) * Me - QX = 0.5d+00 * Pe - F1 = W * F1a + W1 * F1b + DU * ER1 - F2 = W * F2a + W1 * F2b + DU * ER2 - P1 = W * P1a + W1 * P1b + QX - P2 = W * P2a + W1 * P2b + QX - Pe = Pe - DU * EQe - Pe1 = - DU * EQe1 - end if - end if - end function TPMInteractionFC1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - integer(c_int) function TPMInteractionFW1 ( QQ, U, U1, U2, UU, F1, F2, F, Fe, G1, G2, R1, R2, N, NMAX, R, Re, EType ) - real(c_double), intent(out) :: U, U1, U2 - integer(c_int), intent(in) :: N, NMAX, EType - real(c_double), dimension(0:NMAX-1), intent(out) :: QQ, UU - real(c_double), dimension(0:2), intent(out) :: F1, F2, Fe - real(c_double), dimension(0:2,0:NMAX-1), intent(out) :: F, G1, G2 - real(c_double), dimension(0:2), intent(in) :: R1, R2, Re - real(c_double), dimension(0:2,0:NMAX-1), intent(in) :: R - !------------------------------------------------------------------------------------------- - integer(c_int) :: i, j - real(c_double) :: Q, WW, DD - !------------------------------------------------------------------------------------------- - Q1 = 0.0d+00 - Q2 = 0.0d+00 - WW = 0.0d+00 - Z1 = 0.0d+00 - Z2 = 0.0d+00 - TPMInteractionFW1 = 0 - E10 = 0.5d+00 * ( R2 - R1 ) - L10 = sqrt ( S_V3xx ( E10 ) + sqr ( TPMR1 ) ) - D10 = TPMR1 + TPMR2 + TPMC123 * TPBRcutoff + RSkin - E10 = E10 / L10 - RR = 0.5d+00 * ( R1 + R2 ) - do i = 0, N - 2 - call PairWeight1 ( W(i), E1(0:2,i), E2(0:2,i), EE1(0:2,i), EE2(0:2,i), R(0:2,i), R(0:2,i+1) ) - Q1 = Q1 + W(i) * R(0:2,i) - Q2 = Q2 + W(i) * R(0:2,i+1) - WW = WW + W(i) - Z1 = Z1 + E1(0:2,i) - Z2 = Z2 + E2(0:2,i) - end do - if ( WW .le. TPGeomPrec ) return - Q1 = Q1 / WW - Q2 = Q2 / WW - Z1 = Z1 / WW - Z2 = Z2 / WW - if ( EType == 1 ) then - Qe = R(0:2,0) - Qe1 = R(0:2,1) - else if ( EType == 2 ) then - Qe = R(0:2,N-1) - Qe1 = R(0:2,N-2) - else if ( EType == 3 ) then - Qe = Re - Qe1 = R(0:2,0) - else if ( EType == 4 ) then - Qe = Re - Qe1 = R(0:2,N-1) - else - Qe = 0.0d+00 - Qe1 = 0.0d+00 - end if - - TPMInteractionFW1 = TPMInteractionFC1 ( Q, U, F1, F2, S1, S2, Pe, Pe1, R1, R2, Q1, Q2, Qe, Qe1, EType ) - if ( TPMInteractionFW1 == 0 ) return - - W(0:N-2) = W(0:N-2) / WW - E1(0:2,0:N-2) = E1(0:2,0:N-2) / WW - E2(0:2,0:N-2) = E2(0:2,0:N-2) / WW - EE1(0:2,0:N-2) = EE1(0:2,0:N-2) / WW - EE2(0:2,0:N-2) = EE2(0:2,0:N-2) / WW - G1(0:2,0:N-1) = 0.0d+00 - G2(0:2,0:N-1) = 0.0d+00 - U1 = 0.25d+00 * U - U2 = U1 - UU = 0.0d+00 - do i = 0, N - 2 - QQ(i) = W(i) * Q - DD = W(i) * U1 - UU(i) = UU(i) + DD - UU(i+1) = UU(i+1) + DD - end do - do i = 0, N - 2 - C(i) = S_V3xV3 ( S1, R(0:2,i) ) + S_V3xV3 ( S2, R(0:2,i+1) ) - F1 = F1 + C(i) * ( E1(0:2,i) - W(i) * Z1 ) - F2 = F2 + C(i) * ( E2(0:2,i) - W(i) * Z2 ) - end do - F(0:2,0) = W(0) * S1 - do j = 0, N - 2 - if ( j == 0 ) then - DR = EE1(0:2,0) * ( 1.0d+00 - W(0) ) - else - DR = - W(j) * EE1(0:2,0) - end if - F(0:2,0) = F(0:2,0) + C(j) * DR - end do - do i = 1, N - 2 - G1(0:2,i) = W(i-1) * S2 - G2(0:2,i) = W(i) * S1 - do j = 0, N - 2 - if ( j == i ) then - G1(0:2,i) = G1(0:2,i) - C(j) * W(j) * EE2(0:2,i-1) - G2(0:2,i) = G2(0:2,i) + C(j) * ( EE1(0:2,j) - W(j) * EE1(0:2,i) ) - else if ( j == i - 1 ) then - G1(0:2,i) = G1(0:2,i) + C(j) * ( EE2(0:2,j) - W(j) * EE2(0:2,i-1) ) - G2(0:2,i) = G2(0:2,i) - C(j) * W(j) * EE1(0:2,i) - else - G1(0:2,i) = G1(0:2,i) - C(j) * W(j) * EE2(0:2,i-1) - G2(0:2,i) = G2(0:2,i) - C(j) * W(j) * EE1(0:2,i) - end if - end do - F(0:2,i) = G1(0:2,i) + G2(0:2,i) - end do - F(0:2,N-1) = W(N-2) * S2 - do j = 0, N - 2 - if ( j == N - 2 ) then - DR = EE2(0:2,N-2) * ( 1.0d+00 - W(N-2) ) - else - DR = - W(j) * EE2(0:2,N-2) - end if - F(0:2,N-1) = F(0:2,N-1) + C(j) * DR - end do - Fe = 0.0d+00 - if ( EType == 1 ) then - F(0:2,0) = F(0:2,0) - Pe - else if ( EType == 2 ) then - F(0:2,N-1) = F(0:2,N-1) - Pe - else if ( EType == 3 ) then - F(0:2,0) = F(0:2,0) - Pe1 - Fe = - Pe - else if ( EType == 4 ) then - F(0:2,N-1) = F(0:2,N-1) - Pe1 - Fe = - Pe - end if - G1(0:2,N-1) = F(0:2,N-1) - G2(0:2,0) = F(0:2,0) - end function TPMInteractionFW1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -end module TPMM1 !********************************************************************************** diff --git a/tools/mesont/dump2vtk.cpp b/tools/mesont/dump2vtk.cpp new file mode 100644 index 0000000000..88ebdee161 --- /dev/null +++ b/tools/mesont/dump2vtk.cpp @@ -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 +#include +#include +#include +#include +#include +#include +#include +#include +#include +//#include + +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 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(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> 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; +}