├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── doc └── index.html ├── pkgIndex.tcl ├── topoangles.tcl ├── topoatoms.tcl ├── topobonds.tcl ├── topocrossterms.tcl ├── topodihedrals.tcl ├── topogromacs.tcl ├── topohelpers.tcl ├── topoimpropers.tcl ├── topolammps.tcl ├── topotools.tcl ├── topoutils.tcl └── topovarxyz.tcl /.gitignore: -------------------------------------------------------------------------------- 1 | # Backup files 2 | *# 3 | *~ 4 | *.swp 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | VMD topotools package. Version 1.10 2 | Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020,2021,2022,2023,2024,2025 3 | by Axel Kohlmeyer and contributers listed in the code. 4 | All rights reserved. 5 | ------------------- 6 | 7 | Redistribution and use in source and binary forms, with or without modification, 8 | are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright notice, this 11 | list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above copyright notice, this 14 | list of conditions and the following disclaimer in the documentation and/or 15 | other materials provided with the distribution. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 21 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 24 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .SILENT: 2 | 3 | VMFILES = pkgIndex.tcl topotools.tcl topoatoms.tcl \ 4 | topobonds.tcl topoangles.tcl topodihedrals.tcl topoimpropers.tcl \ 5 | topocrossterms.tcl topolammps.tcl topoutils.tcl topohelpers.tcl \ 6 | topogromacs.tcl topovarxyz.tcl 7 | 8 | VMVERSION = 1.10 9 | DIR = $(PLUGINDIR)/noarch/tcl/topotools$(VMVERSION) 10 | 11 | bins: 12 | win32bins: 13 | dynlibs: 14 | staticlibs: 15 | win32staticlibs: 16 | 17 | distrib: 18 | @echo "Copying topotools $(VMVERSION) files to $(DIR)" 19 | mkdir -p $(DIR) 20 | cp $(VMFILES) $(DIR) 21 | cp README.md $(DIR)/README 22 | 23 | 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # VMD TopoTools package. Version 1.10 2 | 3 | Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020,2022,2023,2024,2025 4 | by Axel Kohlmeyer 5 | 6 | [![DOI](https://zenodo.org/badge/13922095.svg)](https://zenodo.org/badge/latestdoi/13922095) 7 | 8 | This package contains contributed features from: 9 | - Josh Vermaas (fully working gromacs topology files for CHARMM) 10 | - Konstantin W (replicatemols for non-orthogonal cells) 11 | 12 | ------------------- 13 | 14 | ## Overview 15 | 16 | TopoTools is a plugin for [VMD](http://www.ks.uiuc.edu/Research/vmd/) 17 | providing a collection of Tcl commands to manipulate, build, read 18 | and write topologies (i.e. bonds, angles, dihedrals, etc. 19 | and their corresponding properties (type, order, etc.). 20 | 21 | ## Updates 22 | 23 | The public git repository is at https://github.com/akohlmey/topotools 24 | 25 | TopoTools version 1.10 is the **final** release created by **me**. 26 | I have no more plans to further develop and maintain this package. 27 | It is therefore available for "adoption". Please contact me via email 28 | or PM if you want to take over. 29 | 30 | ## Installation 31 | 32 | TopoTools is written entirely in the Tcl scripting language 33 | for use as a plugin with VMD. A version of TopoTools is already 34 | bundled with VMD, to update it with the newer, downloaded version 35 | unpack the TopoTools archive, which will create a directory 36 | containing that various Tcl script files. If the directory is not 37 | named topotools1.10, please rename it accordingly. Now, find the 38 | plugin folder in your VMD installation where it already has 39 | a topotools1.x directory and move the folder with the new version 40 | next to it. If it already has the topotools1.10 folder, overwrite 41 | the files inside with the new version. VMD should use the new 42 | version automatically at the next start. 43 | 44 | -------------------------------------------------------------------------------- /doc/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 |
7 |

   Contents

8 | 69 |
70 | 71 |

Scope and usage

72 |

73 | Since VMD version 1.8.7 it is possible to store the complete topology 74 | information, i.e. not only bonds, but also angle, dihedral, and 75 | improper definitions as well as their force field type labels (if 76 | available). This allows to do a large variety of modifications to 77 | topology data or even building topologies from scratch. The focus lies 78 | hereby on being able to perform many operations manually or scripted and 79 | thus being less focused on and optimized for biomolecules like 80 | psfgen.

81 |

In combination with the command 82 | mol new atoms <number> it is also possible 83 | to do many operations directly that previously required writing and 84 | manipulating temporary files and reading them back into VMD, or even 85 | write complete molecule or simulation data readers in Tcl script. This 86 | is especially useful for file formats, where additional input from the 87 | user is required, for example reading LAMMPS format "data" (=topology) 88 | files, where the "style" of theAtoms section cannot be deduced 89 | from the data. Of course write support is also possible.

90 |

The underlying Tcl script API in VMD itself had been 91 | designed to be minimalistic, since most operations are not 92 | computationally demanding and could be programmed with scripting. The 93 | topotools packages is supposed to provide a middleware, 94 | i.e. more powerful and easy to use script commands that make combine 95 | multiple low lever commands in a way to solve common tasks conveniently 96 | and efficiently.

97 |

Finally topotools also contains some utilities and 98 | applications for more complex operations like combining multiple molecules 99 | (=different files) or multiple selections into one new molecule, or building 100 | larger systems by replicating a given unitcell.

101 | 102 |

Version

103 |

This documentation describes version 1.10 of the topotools plugin. 104 | This is the final version of this plugin unless a new maintainer is found. If you 105 | are interested in maintaining TopoTools, please contact the original author, 106 | Axel Kohlmeyer via email.

107 |

Main command interface

108 |

This is the middleware part of the package that provides abstract operations on top of the low-level API. This is modeled after the example of the internal mol or molinfo commands, or the pbc command from the PBCTools package to provide a somewhat consistent interface to the functionality. All command lines start with the topo keyword and then take a subcommand name to determine the actual functionality that is requested.

109 |
topo <command> [args...] <flags>
110 |

Common flags

111 |

The following flags can be passed on to all subsequent topo commands. They will select the molecule to which the operation should be applied to and also the set of atoms. The -sel transparently handles both, previously defined selection functions or selection texts, as arguments. For operations on bonds, angles, dihedrals, and impropers selections will be applied in such a way that only topological data where all atoms are contained in the selection.

112 |
113 |
-molid <num>|top          molecule id (default: 'top')
114 |
-sel <selection>          atom selection function or text (default: 'all')
115 |
116 |

The following flags can be added to subsequently documented operations on bonds. Bond information is treated and stored differently from angles, dihedrals, and impropers in VMD, since bond information is used for visualization and the others not. This also results in performance differences in commands operating on the two groups.

117 |
118 |
-bondtype  <typename>   bond type name (default: unknown)
119 |
-bondorder <bondorder>  bond order parameter (default: 1)
120 |
121 |

numatoms

122 |

Returns the number of atoms.

123 |

numatomtypes

124 |

Returns the number of atom types as determined from the type property.

125 |

atomtypenames

126 |

Returns the list of unique atom types names. The list has topo numatomtypes entries.

127 |

guessatom <property> <from>

128 |

Resets per atom data through selected heuristics. This is most useful to recover some data when using a file format that doesn't set contain these properties, or when they cannot be reliably determined, so the user should choose which ones work. The following combinations are supported:

129 | 141 |

numbonds

142 |

Returns the number of bonds.

143 |

numbondtypes

144 |

Returns the number of unique bond types.

145 |

bondtypenames

146 |

Returns a list of all unique bond types. The list has topo numbondtypes entries.

147 |

clearbonds

148 |

Delete all bonds. 149 |

150 |

retypebonds

151 |

Assign new bond types composed of the atom type strings connected with a '-' character. Bond types are canonicalized so that the atom type with the lower dictionary sort value will be placed on the left and the other on the right.

152 |

addbond <id1> <id2> [-bondtype <type>] [-bondorder <order>]

153 |

Defines a bond bone between the two specified atoms. This does nothing if one of the two atom indices is outside the selection. You can specify the bond type and order via the optional flags -bondtype or -bondorder.

154 |

delbond <id1> <id2>

155 |

Deletes a bond between the two specified atoms. This does nothing if the bond does not exist or one of the two atom indices is outside the selection.

156 |

getbondlist [type|order|both|none]

157 |

Returns a list of unique bonds, the individual bond is a list of the atom indices forming the bond and optionally added the bond type name and/or the bond order value.

158 |

setbondlist [type|order|both|none] <list>

159 |

Defines bonds from a list in a format as returned by topo getbondlist. This is essentially a shortcut for calling topo clearbonds and a sequence of topo addbond commands with some optimization for the case of a selection encompassing all atoms.

160 |

num(angle|dihedral|improper|crossterm)s

161 |

Returns the number of angles, dihedrals, impropers or crossterms.

162 |

num(angle|dihedral|improper)types

163 |

Returns the number of unique angle-, dihedral-, or improper-types.

164 |

(angle|dihedral|improper)typenames

165 |

Returns a list of all unique angles, dihedrals, or impropers. The list has topo num(angle|dihedral|improper)types entries.

166 |

clear(angle|dihedral|improper|crossterm)s

167 |

Deletes the currently defined angles, dihedrals, impropers, or crossterms.

168 |

sort(angle|dihedral|improper)s

169 |

Sorts and canonicalizes the list of angles, dihedrals, or impropers. Duplicates are removed and the list is sorted by atom types.

170 |

retype(angle|dihedral|improper)s

171 |

Assign new angle, dihedral, or improper types composed of the atom type strings connected with a '-' character. The resulting types are canonicalized and sorted.

172 |

guess(angle|dihedral)s

173 |

Guess angle or dihedral definitions from the bond topology. An angle is defined by two bonds sharing an atom and a dihedral by two bonds sharing a bond. Types are assigned in the same way as in the corresponging retype command.

174 |

guessimpropers [tolerance <degrees>]

175 |

Guess improper angles. Are defined for atoms that are bonded to exactly 3 atoms when they form a near flat structure. The tolerance flag can be used as a cutoff for what is to be considered as "flat" and what not.

176 |

addangle <type> <id1> <id2> <id3> <type>

177 |

Defines an angle of type <type> between the three specified atoms. All three atoms have to be contained in the specified atom selection ('all' if none is given) or else the command is ignored. No further checks are being performed on the input.

178 |

delangle <id1> <id2> <id3>

179 |

Deletes an angle between the three specified atoms. Does nothing if not all three atom indices are contained within the given selection (default 'all').

180 |

getanglelist

181 |

Returns a list of defined angles with each entry in the format {type <index 1> <index 2> <index 3>}. The type name may be set to {}, if no angletype has been set. The list is printed unsorted as it is stored in VMD.

182 |

setanglelist <list>

183 |

Resets the angle definitions from a list in a format as returned by topo getanglelist. This is essentially a shortcut for calling topo clearbonds and a sequence of topo addangle commands with some optimization for the case of a selection encompassing all atoms.

184 |

adddihedral <id1> <id2> <id3> <id4> <type>

185 |

Defines a dihedral of type <type> between the four specified atoms. All four atoms have to be contained in the specified atom selection ('all' if none is given) or else the command is ignored. No further checks are being performed on the input.

186 |

deldihedral <idx1> <id2> <id3> <id4>

187 |

Deletes the dihedral between the four specified atoms. Does nothing if not all four atom indices are contained within the given selection (default 'all').

188 |

addimproper <id1> <id2> <id3> <id4> <type>

189 |

Defines an improper of type <type> between the four specified atoms. All four atoms have to be contained in the specified atom selection ('all' if none is given) or else the command is ignored. No further checks are being performed on the input.

190 |

delimproper <id1> <id2> <id3> <id4>

191 |

Deletes the improper between the four specified atoms. Does nothing if not all four atom indices are contained within the given selection (default 'all').

192 |

get(dihedral|improper)list

193 |

Returns a list of defined dihedrals or impropers with each entry in the format {type <index 1> <index 2> <index 3> <index 4>}. The type name may be set to {}, if no type has been set. The list is printed unsorted as it is stored in VMD.

194 |

set(dihedral|improper)list <list>

195 |

Resets the dihedral or improper definitions from a list in a format as returned by topo getdihedrallist or topo getimproperlist. This is essentially a shortcut notation for clearing and then resetting them individually.

196 |

addcrossterm <id1> <id2> <id3> <id4> <id5> <id6> <id7> <id8>

197 |

Defines a crossterm between the eight specified atoms. All eight atoms have to be contained in the specified atom selection ('all' if none is given) or else the command is ignored. No further checks are being performed on the input.

198 |

delcrossterm <id1> <id2> <id3> <id4> <id5> <id6> <id7> <id8>

199 |

Deletes the crossterm between the eight specified atoms. Does nothing if not all eight atom indices are contained within the given selection (default 'all').

200 |

getcrosstermlist

201 |

Returns a list of defined crossterms with each entry in the format {<index 1> <index 2> <index 3> <index 4> <index 5> <index 6> <index 7> <index 8>}. The list is printed unsorted as it is stored in VMD.

202 |

setcrosstermlist <list>

203 |

Resets the crossterm definitions from a list in a format as returned by topo getcrosstermlist. This is essentially a shortcut notations for clearing and then resetting them individually.

204 | 205 |

File I/O Commands

206 |

TopoTools provides a number of file I/O commands that contrast from the molfile plugins in such that they use Tcl scripting to read and write files. This provides additional flexibility and allows to easily pass flags to the reader or writer, that are not available in the molfile plugin API, however, it may also results in reduced reading performance. All of the file I/O commands also use the topo prefix and support the commonly supported optional flags for specifying molecule id and atom selection.

207 |

readlammpsdata <file name> [<atom style>]

208 |

Read in atom coordinates, properties, bond, angle, dihedral and other related topology info from a LAMMPS data file, i.e. a file suitable for the read_data command. This can be used to check a data file for its validity, for manipulations from within VMD, or to generate a .psf file to be used for visualization of .dcd or .xtc format trajectory files in VMD. The 'atom style' is the value given to the atom_style command in the LAMMPS input file (by default TopoTools will try to infer the atom style from information embedded in the data file as comments; if no such hints are present, it will use 'full'). This subcommand creates a new molecule in VMD and returns its molecule id or -1 in case of failure. The -sel parameter is currently ignored.

209 |

writelammpsdata <file name> [typelabels] [<atom style>]

210 |

Write out atom coordinates, properties, bond, angle, dihedral and other related topology info stored inside VMD to a LAMMPS data file, i.e. a file suitable for the read_data command. Using the optional 'typelabels' flag will trigger writing a data file with typelabel support requiring LAMMPS version 15Sep2022 or later. By default a traditional data file with numerical types will be written. This this way VMD can be used to build LAMMPS input with Tcl scripting and convert existing inputs from other MD codes to be used in LAMMPS. For some examples, please see the TopoTools tutorials. The 'atom style' is the value you want to give to the atom_style command in the LAMMPS input file (default is 'full'). Only data that is present will be written and non-zero box sizes are required.

211 |

readvarxyz <file name>

212 |

Read in an xyz-format trajectory file (in xmol style) with a varying number of atoms per frame. This format is normally not supported in VMD and the script circumvents the restriction by automatically adding a sufficient number of dummy particles. Whether an atom is actually present in a given frame or not is flagged by the value of the corresponding user field, which is set to either 1.0 or -1.0, respectively. For efficiency reasons the atoms are sorted by type, thus atom order and bonding is not preserved. This subcommand creates a new molecule and returns its molecule id or -1, in case of failure.

213 |

writevarxyz <file name> [selmod <sel>] [first|last|step <frame]

214 |
Write out an xyz-format trajectory file with a varying number of atoms per frame. This is the counterpart to the readvarxyz subcommand. The optional selection string defines how atoms for each frame have to be selected. If not given, as selection string of "user > 0" is assumed.
215 |

writegmxtop <file name> [<list of CHARMM parameter files>]

216 |

Write a gromacs-style topology file that can be used in combination with a .gro or .pdb file to generate a .tpr file with the gromacs grompp tool. Such .tpr files are used to run simulations and for some of the more advanced gromacs analysis tools. If one or more parameter files (in CHARMM format) are provided, the resulting topology file is suitable for running MD simulations using the provided parameters. This allows the preparation of systems with CHARMM tools and to run the simulations with gromacs instead. A paper describing this TopoGromacs functionality is available at doi:10.1021/acs.jcim.6b00103. If the parameter files are omitted, dummy values are included instead so that the generated incomplete topology (and the from it generated .tpr file) are still sufficient to analyze trajectories, since analysis tools do not need force field parameters. This is useful for using gromacs tools to analyse trajectories that were not generated with gromacs and thus no .tpr file exists. Such a topology/.tpr file with dummy parameters is in no way suitable to start a correct MD simulation, though. Usage example:

package require topotools 1.6
# Load the structure into VMD.
mol new structure.psf
mol addfile structure.pdb
# Pass along a list of parameters to generate structure.top, suitable for preparing gromacs simulations.
topo writegmxtop structure.top [list parameterfile1.prm parameterfile2.prm]
# This would be prepared for simulation using grompp to create a tpr file
# gmx grompp -f simulationsetup.mdp -c structure.pdb -p structure.top -o simulation.tpr

217 | 218 |

Utility Functions

219 |

These are useful and convenient tools written on top of the topotools API. You can access them directly with their ::TopoTools:: namespace prefix or use namespace import ::TopoTools::<pattern> to import some or all of them (with the pattern '*') into your current namespace.

220 |

mergemols <list of molecule ids>

221 |

Combines multiple separate molecules into one file. This is non-destructive and will create a new molecule. The molecule id of the new molecule is returned, or -1 in case of a failure. Usage example:

222 |
package require topotools 1.6 223 |
# load to be merged molecules into VMD
224 |
set midlist {}
225 |
set mol [mol new part1.psf waitfor all]
226 |
mol addfile part1.pdb
227 |
lappend midlist $mol
228 |
set mol [mol new part2.psf waitfor all]
229 |
mol addfile part2.pdb $mol
230 |
lappend midlist $mol
231 |
# do the magic
232 |
set mol [::TopoTools::mergemols $midlist]
233 |
animate write psf merged.psf $mol
234 |
animate write pdb merged.pdb $mol
235 |
236 | 237 |

selections2mol <list of atom selections>

This is very similar to the previous mergemols command. It combines one or multiple atom selections, which can be taken from different molecules, into one new molecule. This is also non-destructive and will create a new molecule. The molecule id of the new molecule is returned, or -1 in case of a failure. Usage example:

238 |
package require topotools 1.6 239 |
set sellist {}
240 |
set sel [atomselect 0 protein]
241 |
lappend sellist $sel
242 |
set sel [atomselect 0 protein]
243 |
$sel frame 200 
244 |
$sel moveby {50.0 50.0 0.0}
245 |
lappend sellist $sel
246 |
set sel [atomselect 1 "same residue as (within 3.0 of chain L)"]
247 |
lappend sellist $sel
248 |
# do the magic
249 |
set mol [::TopoTools::selections2mol $sellist]
250 |
animate write psf combinedsel.psf $mol
251 |
animate write pdb combinedsel.pdb $mol
252 |
253 | 254 |

replicatemol <mol> <nx> <ny> <nz>

255 |

Replicate the current unitcell according to integer replicate counts. Usage example:

256 |
package require topotools 1.5
# load a molecule
set mol [mol new pegc12e8-small.xml type hoomd waitfor all]
# do the magic
set newmol [::TopoTools::replicatemol $mol 2 2 1 ]
animate write hoomd replicated.xml $newmol
257 |

258 |
259 | 260 | 261 | 262 |

Author

263 |

Axel Kohlmeyer with contributions from Josh Vermaas (TopoGromacs, i.e. fully working gromacs topology files for CHARMM style parameter files) and Konstantin W (replicatemols for non-orthogonal cells)

264 | 265 | 266 | 267 | -------------------------------------------------------------------------------- /pkgIndex.tcl: -------------------------------------------------------------------------------- 1 | # Tcl package index file, version 1.1 2 | # This file is generated by the "pkg_mkIndex" command 3 | # and sourced either when an application starts up or 4 | # by a "package unknown" script. It invokes the 5 | # "package ifneeded" command to set up package-related 6 | # information so that packages will be loaded automatically 7 | # in response to "package require" commands. When this 8 | # script is sourced, the variable $dir must contain the 9 | # full path name of this file's directory. 10 | 11 | package ifneeded topotools 1.10 "set env(TOPOTOOLSDIR) {$dir}; [list source [file join $dir topotools.tcl]]" 12 | -------------------------------------------------------------------------------- /topoangles.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # This file is part of TopoTools, a VMD package to simplify 3 | # manipulating bonds other topology related properties. 4 | # 5 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer 6 | # $Id: topoangles.tcl,v 1.13 2020/05/29 19:47:40 johns Exp $ 7 | 8 | # return info about angles 9 | # we list and count only angles that are entirely within the selection. 10 | proc ::TopoTools::angleinfo {infotype sel {flag none}} { 11 | 12 | set numangles 0 13 | array set angletypes {} 14 | set atomindex [$sel list] 15 | set anglelist {} 16 | 17 | foreach angle [join [molinfo [$sel molid] get angles]] { 18 | lassign $angle t a b c 19 | 20 | if {([lsearch -sorted -integer $atomindex $a] >= 0) \ 21 | && ([lsearch -sorted -integer $atomindex $b] >= 0) \ 22 | && ([lsearch -sorted -integer $atomindex $c] >= 0) } { 23 | set angletypes($t) 1 24 | incr numangles 25 | lappend anglelist $angle 26 | } 27 | } 28 | switch $infotype { 29 | 30 | numangles { return $numangles } 31 | numangletypes { return [array size angletypes] } 32 | angletypenames { return [lsort -ascii [array names angletypes]] } 33 | getanglelist { return $anglelist } 34 | default { return "bug! shoot the programmer?"} 35 | } 36 | } 37 | 38 | # delete all fully contained angles of the selection. 39 | proc ::TopoTools::clearangles {sel} { 40 | set mol [$sel molid] 41 | set atomindex [$sel list] 42 | set anglelist {} 43 | 44 | foreach angle [join [molinfo $mol get angles]] { 45 | lassign $angle t a b c 46 | 47 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 48 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 49 | || ([lsearch -sorted -integer $atomindex $c] < 0) } { 50 | lappend anglelist $angle 51 | } 52 | } 53 | molinfo $mol set angles [list $anglelist] 54 | } 55 | 56 | # reset angles to data in anglelist 57 | proc ::TopoTools::setanglelist {sel anglelist} { 58 | 59 | set mol [$sel molid] 60 | set atomindex [$sel list] 61 | set newanglelist {} 62 | 63 | # set defaults 64 | set t unknown; set a -1; set b -1; set c -1 65 | 66 | # preserve all angles definitions that are not contained in $sel 67 | foreach angle [join [molinfo $mol get angles]] { 68 | lassign $angle t a b c 69 | 70 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 71 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 72 | || ([lsearch -sorted -integer $atomindex $c] < 0) } { 73 | lappend newanglelist $angle 74 | } 75 | } 76 | 77 | # append new ones, but only those fully contained in $sel 78 | foreach angle $anglelist { 79 | lassign $angle t a b c 80 | 81 | if {([lsearch -sorted -integer $atomindex $a] >= 0) \ 82 | && ([lsearch -sorted -integer $atomindex $b] >= 0) \ 83 | && ([lsearch -sorted -integer $atomindex $c] >= 0) } { 84 | lappend newanglelist $angle 85 | } 86 | } 87 | 88 | molinfo $mol set angles [list $newanglelist] 89 | } 90 | 91 | # reset angles to data in anglelist 92 | proc ::TopoTools::retypeangles {sel} { 93 | 94 | set mol [$sel molid] 95 | set anglelist [angleinfo getanglelist $sel] 96 | set atomtypes [$sel get type] 97 | set atomindex [$sel list] 98 | set newanglelist {} 99 | 100 | foreach angle $anglelist { 101 | lassign $angle type i1 i2 i3 102 | 103 | set idx [lsearch -sorted -integer $atomindex $i1] 104 | set a [lindex $atomtypes $idx] 105 | set idx [lsearch -sorted -integer $atomindex $i2] 106 | set b [lindex $atomtypes $idx] 107 | set idx [lsearch -sorted -integer $atomindex $i3] 108 | set c [lindex $atomtypes $idx] 109 | 110 | if { [string compare $a $c] > 0 } { set t $a; set a $c; set c $t } 111 | set type [join [list $a $b $c] "-"] 112 | 113 | lappend newanglelist [list $type $i1 $i2 $i3] 114 | } 115 | setanglelist $sel $newanglelist 116 | } 117 | 118 | # reset angles to definitions derived from bonds. 119 | # this includes retyping of the angles. 120 | proc ::TopoTools::guessangles {sel} { 121 | 122 | set mol [$sel molid] 123 | set atomtypes [$sel get type] 124 | set atomindex [$sel list] 125 | set newanglelist {} 126 | 127 | set bonddata [$sel getbonds] 128 | 129 | # preserve all angles definitions that are not fully contained in $sel 130 | foreach angle [angleinfo getanglelist $sel] { 131 | lassign $angle t a b c 132 | 133 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 134 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 135 | || ([lsearch -sorted -integer $atomindex $c] < 0) } { 136 | lappend newanglelist $angle 137 | } 138 | } 139 | 140 | # a topological angle is defined by two bonds that share an atom 141 | # bound to it that are not the bond itself 142 | foreach bonds $bonddata aidx $atomindex atyp $atomtypes { 143 | set nbnd [llength $bonds] 144 | for {set i 0} {$i < $nbnd-1} {incr i} { 145 | for {set j [expr {$i+1}]} {$j < $nbnd} {incr j} { 146 | set b1idx [lindex $bonds $i] 147 | set idx [lsearch -sorted -integer $atomindex $b1idx] 148 | set b1typ [lindex $atomtypes $idx] 149 | set b2idx [lindex $bonds $j] 150 | set idx [lsearch -sorted -integer $atomindex $b2idx] 151 | set b2typ [lindex $atomtypes $idx] 152 | if { ([string compare $b1typ $b2typ] > 0) } { 153 | set t1 $b1typ; set b1typ $b2typ; set b2typ $t1 154 | set t2 $b1idx; set b1idx $b2idx; set b2idx $t2 155 | } 156 | set type [join [list $b1typ $atyp $b2typ] "-"] 157 | 158 | # append only angles that are full contained in $sel 159 | if {([lsearch -sorted -integer $atomindex $b1idx] >= 0) \ 160 | && ([lsearch -sorted -integer $atomindex $aidx] >= 0) \ 161 | && ([lsearch -sorted -integer $atomindex $b2idx] >= 0) } { 162 | lappend newanglelist [list $type $b1idx $aidx $b2idx] 163 | } 164 | } 165 | } 166 | } 167 | molinfo $mol set angles [list $newanglelist] 168 | } 169 | 170 | # define a new angle or change an existing one. 171 | proc ::TopoTools::addangle {mol id1 id2 id3 {type unknown}} { 172 | if {[catch {atomselect $mol "index $id1 $id2 $id3"} sel]} { 173 | vmdcon -err "topology addangle: Invalid atom indices: $sel" 174 | return 175 | } 176 | 177 | # canonicalize indices 178 | if {$id1 > $id3} {set t $id1 ; set id1 $id3 ; set id3 $t } 179 | 180 | set angles [join [molinfo $mol get angles]] 181 | lappend angles [list $type $id1 $id2 $id3] 182 | $sel delete 183 | molinfo $mol set angles [list $angles] 184 | } 185 | 186 | # delete an angle. 187 | proc ::TopoTools::delangle {mol id1 id2 id3 {type unknown}} { 188 | if {[catch {atomselect $mol "index $id1 $id2 $id3"} sel]} { 189 | vmdcon -err "topology delangle: Invalid atom indices: $sel" 190 | return 191 | } 192 | 193 | # canonicalize indices 194 | if {$id1 > $id3} {set t $id1 ; set id1 $id3 ; set id3 $t } 195 | 196 | set newanglelist {} 197 | foreach angle [join [molinfo $mol get angles]] { 198 | lassign $angle t a b c 199 | if { ($a != $id1) || ($b != $id2) || ($c != $id3) } { 200 | lappend newanglelist $angle 201 | } 202 | } 203 | $sel delete 204 | molinfo $mol set angles [list $newanglelist] 205 | } 206 | -------------------------------------------------------------------------------- /topoatoms.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # This file is part of TopoTools, a VMD package to simplify 3 | # manipulating bonds other topology related properties. 4 | # 5 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer 6 | # $Id: topoatoms.tcl,v 1.17 2020/05/29 19:47:40 johns Exp $ 7 | 8 | # Return info about atoms 9 | # we list and count only bonds that are entirely within the selection. 10 | proc ::TopoTools::atominfo {infotype sel {flag none}} { 11 | 12 | set atomtypes [lsort -ascii -unique [$sel get type]] 13 | 14 | switch $infotype { 15 | numatoms { return [$sel num] } 16 | numatomtypes { return [llength $atomtypes] } 17 | atomtypenames { return $atomtypes } 18 | default { return "bug? shoot the programmer!"} 19 | } 20 | } 21 | 22 | # guess missing atomic property from periodic table data. numbers are 23 | # taken from the corresponding lists in the molfile plugin header. 24 | # TODO: additional guesses: element-name, mass-element, radius-element, ... 25 | proc ::TopoTools::guessatomdata {sel what from} { 26 | variable elements 27 | variable masses 28 | variable radii 29 | 30 | set selstr [$sel text] 31 | 32 | switch -- "$what-$from" { 33 | lammps-data { 34 | # shortcut for lammps data files 35 | guessatomdata $sel element mass 36 | guessatomdata $sel name element 37 | guessatomdata $sel radius element 38 | } 39 | 40 | element-mass { 41 | foreach a [lsort -real -unique [$sel get mass]] { 42 | set s [atomselect [$sel molid] "mass $a and ( $selstr )"] 43 | $s set element [lindex $elements [ptefrommass $a]] 44 | $s delete 45 | } 46 | } 47 | 48 | element-name { 49 | foreach n [lsort -ascii -unique [$sel get name]] { 50 | set s [atomselect [$sel molid] "name '$n' and ( $selstr )"] 51 | set idx [lsearch -nocase $elements $n] 52 | if { $idx < 0} { 53 | set n [string range $n 0 1] 54 | set idx [lsearch -nocase $elements $n] 55 | if {$idx < 0} { 56 | set n [string range $n 0 0] 57 | set idx [lsearch -nocase $elements $n] 58 | if {$idx < 0} { 59 | set n X 60 | } else { 61 | set n [lindex $elements $idx] 62 | } 63 | } else { 64 | set n [lindex $elements $idx] 65 | } 66 | } else { 67 | set n [lindex $elements $idx] 68 | } 69 | $s set element $n 70 | $s delete 71 | } 72 | } 73 | 74 | element-type { 75 | foreach t [lsort -ascii -unique [$sel get type]] { 76 | set s [atomselect [$sel molid] "type '$t' and ( $selstr )"] 77 | set idx [lsearch -nocase $elements $t] 78 | if { $idx < 0} { 79 | set t [string range $t 0 1] 80 | set idx [lsearch -nocase $elements $t] 81 | if {$idx < 0} { 82 | set t [string range $t 0 0] 83 | set idx [lsearch -nocase $elements $t] 84 | if {$idx < 0} { 85 | set t X 86 | } else { 87 | set t [lindex $elements $idx] 88 | } 89 | } else { 90 | set t [lindex $elements $idx] 91 | } 92 | } else { 93 | set t [lindex $elements $idx] 94 | } 95 | $s set element $t 96 | $s delete 97 | } 98 | } 99 | 100 | mass-element { 101 | foreach e [lsort -ascii -unique [$sel get element]] { 102 | set s [atomselect [$sel molid] "element '$e' and ( $selstr )"] 103 | set idx [lsearch -nocase $elements $e] 104 | set m 0.0 105 | if {$idx >= 0} { 106 | set m [lindex $masses $idx] 107 | } 108 | $s set mass $m 109 | $s delete 110 | } 111 | } 112 | 113 | name-element { 114 | # name is the same as element, only we go all uppercase. 115 | foreach e [lsort -ascii -unique [$sel get element]] { 116 | set s [atomselect [$sel molid] "element '$e' and ( $selstr )"] 117 | $s set name [string toupper $e] 118 | $s delete 119 | } 120 | } 121 | 122 | name-type { 123 | $sel set name [$sel get type] 124 | } 125 | 126 | radius-element { 127 | foreach e [lsort -ascii -unique [$sel get element]] { 128 | set s [atomselect [$sel molid] "element '$e' and ( $selstr )"] 129 | set idx [lsearch $elements $e] 130 | set r 2.0 131 | if {$idx >= 0} { 132 | set r [lindex $radii $idx] 133 | } 134 | $s set radius $r 135 | $s delete 136 | } 137 | } 138 | 139 | type-element { 140 | # type is the same as element, only we go all uppercase. 141 | foreach e [lsort -ascii -unique [$sel get element]] { 142 | set s [atomselect [$sel molid] "element '$e' and ( $selstr )"] 143 | $s set type [string toupper $e] 144 | $s delete 145 | } 146 | } 147 | 148 | type-name { 149 | $sel set type [$sel get name] 150 | } 151 | 152 | default { 153 | vmdcon -err "guessatomdata: guessing '$what' from '$from' not implemented." 154 | vmdcon -err "Available are: element<-mass, element<-name, mass 6 | # $Id: topobonds.tcl,v 1.16 2020/05/29 19:47:40 johns Exp $ 7 | 8 | # Return info about bonds. 9 | # we list and count only bonds that are entirely within the selection. 10 | proc ::TopoTools::bondinfo {infotype sel {flag none}} { 11 | 12 | set numbonds 0 13 | set bidxlist {} 14 | array set bondtypes {} 15 | 16 | set aidxlist [$sel list] 17 | set bondlist [$sel getbonds] 18 | set btyplist [$sel getbondtypes] 19 | set bordlist [$sel getbondorders] 20 | 21 | foreach a $aidxlist bl $bondlist tl $btyplist ol $bordlist { 22 | foreach b $bl t $tl o $ol { 23 | if {($a < $b) && ([lsearch -sorted -integer $aidxlist $b] != -1)} { 24 | incr numbonds 25 | switch $flag { 26 | type {lappend bidxlist [list $a $b $t]} 27 | order {lappend bidxlist [list $a $b $o]} 28 | both {lappend bidxlist [list $a $b $t $o]} 29 | lammps {lappend bidxlist [list $numbonds $a $b $t]} 30 | none {lappend bidxlist [list $a $b]} 31 | } 32 | } 33 | set bondtypes($t) 1 34 | } 35 | } 36 | 37 | switch $infotype { 38 | numbonds { return $numbonds } 39 | numbondtypes { return [array size bondtypes] } 40 | bondtypenames { return [lsort -ascii [array names bondtypes]] } 41 | getbondlist { return $bidxlist } 42 | default { return "bug? shoot the programmer!"} 43 | } 44 | } 45 | 46 | # delete all contained bonds of the selection. 47 | proc ::TopoTools::clearbonds {sel} { 48 | 49 | # special optimization for "all" selection. 50 | if {[string equal "all" [$sel text]]} { 51 | set nulllist {} 52 | for {set i 0} {$i < [$sel num]} {incr i} { 53 | lappend nullist {} 54 | } 55 | $sel setbonds $nullist 56 | return 57 | } 58 | 59 | set mol [$sel molid] 60 | foreach b [bondinfo getbondlist $sel none] { 61 | delbond $mol [lindex $b 0] [lindex $b 1] 62 | } 63 | } 64 | 65 | # guess bonds from atom radii. Interface to "mol bondsrecalc". 66 | # XXX: currently only works for selection "all". 67 | proc ::TopoTools::guessbonds {sel} { 68 | 69 | set mol [$sel molid] 70 | # special optimization for "all" selection. 71 | if {[string equal "all" [$sel text]]} { 72 | # Use VMD's built-in bond determination heuristic to guess the bonds 73 | mol bondsrecalc $mol 74 | 75 | # Mark the bonds as "validated" so VMD will write 76 | # them out when the structure gets written out, 77 | # e.g. to a PSF file, even if no other bond editing was done. 78 | mol dataflag $mol set bonds 79 | 80 | return 81 | } else { 82 | vmdcon -err "topo guessbonds: this feature currently only works with an 'all' selection" 83 | return 84 | } 85 | } 86 | 87 | # reset bonds to data in bondlist 88 | proc ::TopoTools::setbondlist {sel flag bondlist} { 89 | 90 | clearbonds $sel 91 | set nbnd [llength $bondlist] 92 | if {$nbnd == 0} { return 0} 93 | # set defaults 94 | set n 0 95 | set t unknown 96 | set o 1 97 | set mol [$sel molid] 98 | set a -1 99 | set b -1 100 | set fract [expr {100.0/$nbnd}] 101 | set deltat 2000 102 | set newt $deltat 103 | 104 | # special optimization for "all" selection. 105 | if {[string equal "all" [$sel text]]} { 106 | set nulllist {} 107 | for {set i 0} {$i < [$sel num]} {incr i} { 108 | set blist($i) $nulllist 109 | set olist($i) $nulllist 110 | set tlist($i) $nulllist 111 | } 112 | foreach bond $bondlist { 113 | switch $flag { 114 | type {lassign $bond a b t } 115 | order {lassign $bond a b o } 116 | both {lassign $bond a b t o} 117 | lammps {lassign $bond n a b t} 118 | none {lassign $bond a b } 119 | } 120 | lappend blist($a) $b 121 | lappend blist($b) $a 122 | lappend olist($a) $o 123 | lappend olist($b) $o 124 | lappend tlist($a) $t 125 | lappend tlist($b) $t 126 | } 127 | set dlist {} 128 | for {set i 0} {$i < [$sel num]} {incr i} { 129 | lappend dlist $blist($i) 130 | } 131 | $sel setbonds $dlist 132 | set dlist {} 133 | for {set i 0} {$i < [$sel num]} {incr i} { 134 | lappend dlist $olist($i) 135 | } 136 | $sel setbondorders $dlist 137 | set dlist {} 138 | for {set i 0} {$i < [$sel num]} {incr i} { 139 | lappend dlist $tlist($i) 140 | } 141 | $sel setbondtypes $dlist 142 | return 0 143 | } 144 | 145 | # XXX: fixme! 146 | # using addbond is very inefficient with a large number of bonds 147 | # that are being added. it is better to fill the corresponding 148 | # bondlists directly. the code above should be better, but uses 149 | # much more memory and needs to be generalized. 150 | 151 | # XXX: add sanity check on data format 152 | set i 0 153 | foreach bond $bondlist { 154 | incr i 155 | set time [clock clicks -milliseconds] 156 | if {$time > $newt} { 157 | set percent [format "%3.1f" [expr {$i*$fract}]] 158 | vmdcon -info "setbondlist: $percent% done." 159 | display update ui 160 | set newt [expr {$time + $deltat}] 161 | } 162 | switch $flag { 163 | type {lassign $bond a b t } 164 | order {lassign $bond a b o } 165 | both {lassign $bond a b t o} 166 | lammps {lassign $bond n a b t} 167 | none {lassign $bond a b } 168 | } 169 | addbond $mol $a $b $t $o 170 | } 171 | return 0 172 | } 173 | 174 | # guess bonds type names from atom types. 175 | proc ::TopoTools::retypebonds {sel} { 176 | 177 | set bondlist [bondinfo getbondlist $sel none] 178 | set atomtypes [$sel get type] 179 | set atomindex [$sel list] 180 | set newbonds {} 181 | 182 | foreach bond $bondlist { 183 | set idx [lsearch -sorted -integer $atomindex [lindex $bond 0]] 184 | set a [lindex $atomtypes $idx] 185 | set idx [lsearch -sorted -integer $atomindex [lindex $bond 1]] 186 | set b [lindex $atomtypes $idx] 187 | if { [string compare $a $b] > 0 } { set t $a; set a $b; set b $t } 188 | set type [join [list $a $b] "-"] 189 | lappend newbonds [list [lindex $bond 0] [lindex $bond 1] $type] 190 | } 191 | setbondlist $sel type $newbonds 192 | } 193 | 194 | 195 | # define a new bond or change an existing one. 196 | proc ::TopoTools::addbond {mol id1 id2 type order} { 197 | if {$id1 == $id2} { 198 | vmdcon -err "topo addbond: invalid atom indices: $id1 $id2" 199 | return 200 | } 201 | 202 | if {[catch {atomselect $mol "index $id1 $id2"} sel]} { 203 | vmdcon -err "topo addbond: Invalid atom indices: $sel" 204 | return 205 | } 206 | 207 | # make sure we have consistent indexing 208 | lassign [$sel list] id1 id2 209 | 210 | set bonds [$sel getbonds] 211 | set bords [$sel getbondorders] 212 | set btype [$sel getbondtypes] 213 | 214 | set b1 [lindex $bonds 0] 215 | set b2 [lindex $bonds 1] 216 | set bo1 [lindex $bords 0] 217 | set bo2 [lindex $bords 1] 218 | set bt1 [lindex $btype 0] 219 | set bt2 [lindex $btype 1] 220 | 221 | # handle the first atom... 222 | set pos [lsearch -exact -integer $b1 $id2] 223 | if { $pos < 0} { 224 | lappend b1 $id2 225 | lappend bo1 $order 226 | lappend bt1 $type 227 | } else { 228 | set bo1 [lreplace $bo1 $pos $pos $order] 229 | set bt1 [lreplace $bt1 $pos $pos $type] 230 | } 231 | 232 | # ...and the second one. 233 | set pos [lsearch -exact -integer $b2 $id1] 234 | if { $pos < 0} { 235 | lappend b2 $id1 236 | lappend bo2 $order 237 | lappend bt2 $type 238 | } else { 239 | set bo2 [lreplace $bo2 $pos $pos $order] 240 | set bt2 [lreplace $bt2 $pos $pos $type] 241 | } 242 | 243 | # and write the modified data back. 244 | $sel setbonds [list $b1 $b2] 245 | if {![string equal $order 1.0]} { 246 | $sel setbondorders [list $bo1 $bo2] 247 | } 248 | if {![string equal $type unknown]} { 249 | $sel setbondtypes [list $bt1 $bt2] 250 | } 251 | $sel delete 252 | } 253 | 254 | # delete a bond. 255 | proc ::TopoTools::delbond {mol id1 id2 {type unknown} {order 1.0}} { 256 | if {[catch {atomselect $mol "index $id1 $id2"} sel]} { 257 | vmdcon -err "topology delbond: Invalid atom indices: $sel" 258 | return 259 | } 260 | 261 | # make sure we have consistent indexing 262 | lassign [$sel list] id1 id2 263 | 264 | set bonds [$sel getbonds] 265 | 266 | set b1 [lindex $bonds 0] 267 | set b2 [lindex $bonds 1] 268 | 269 | # handle the first atom... 270 | set pos [lsearch -exact -integer $b1 $id2] 271 | if { $pos < 0} { 272 | ; # bond is not completely within selection. ignore 273 | } else { 274 | set b1 [lreplace $b1 $pos $pos] 275 | } 276 | 277 | # ...and the second one. 278 | set pos [lsearch -exact -integer $b2 $id1] 279 | if { $pos < 0} { 280 | ; # bond is not completely within selection. ignore... 281 | } else { 282 | set b2 [lreplace $b2 $pos $pos] 283 | } 284 | 285 | # and write the modified data back. 286 | $sel setbonds [list $b1 $b2] 287 | $sel delete 288 | } 289 | -------------------------------------------------------------------------------- /topocrossterms.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # This file is part of TopoTools, a VMD package to simplify 3 | # manipulating bonds other topology related properties. 4 | # 5 | # support for crossterms contributed by Josh Vermaas 6 | # 7 | # $Id: topocrossterms.tcl,v 1.5 2020/07/06 05:11:01 johns Exp $ 8 | 9 | 10 | proc ::TopoTools::crossterminfo {infotype sel {flag none}} { 11 | 12 | set numcrossterms 0 13 | set atomindex [$sel list] 14 | set crosstermlist {} 15 | 16 | # for backward compatibility with VMD versions before 1.9.2 17 | set ct {} 18 | if {[catch {molinfo [$sel molid] get crossterms} ct]} { 19 | vmdcon -warn "topotools: VMD [vmdinfo version] does not support crossterms" 20 | set ct {} 21 | } 22 | 23 | foreach crossterm [join $ct] { 24 | lassign $crossterm a b c d e f g h 25 | 26 | if {([lsearch -sorted -integer $atomindex $a] >= 0) \ 27 | && ([lsearch -sorted -integer $atomindex $b] >= 0) \ 28 | && ([lsearch -sorted -integer $atomindex $c] >= 0) \ 29 | && ([lsearch -sorted -integer $atomindex $d] >= 0) \ 30 | && ([lsearch -sorted -integer $atomindex $e] >= 0) \ 31 | && ([lsearch -sorted -integer $atomindex $f] >= 0) \ 32 | && ([lsearch -sorted -integer $atomindex $g] >= 0) \ 33 | && ([lsearch -sorted -integer $atomindex $h] >= 0)} { 34 | incr numcrossterms 35 | lappend crosstermlist $crossterm 36 | } 37 | } 38 | switch $infotype { 39 | 40 | numcrossterms { return $numcrossterms } 41 | getcrosstermlist { return $crosstermlist } 42 | default { return "bug! shoot the programmer?"} 43 | } 44 | } 45 | 46 | # delete all contained crossterms of the selection. 47 | proc ::TopoTools::clearcrossterms {sel} { 48 | set mol [$sel molid] 49 | set atomindex [$sel list] 50 | set crosstermlist {} 51 | 52 | # for backward compatibility with VMD versions before 1.9.2 53 | set ct {} 54 | if {[catch {molinfo [$sel molid] get crossterms} ct]} { 55 | vmdcon -warn "topotools: VMD [vmdinfo version] does not support crossterms" 56 | return -1 57 | } 58 | 59 | foreach crossterm [join $ct] { 60 | lassign $crossterm a b c d e f g h 61 | 62 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 63 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 64 | || ([lsearch -sorted -integer $atomindex $c] < 0) \ 65 | || ([lsearch -sorted -integer $atomindex $d] < 0) \ 66 | || ([lsearch -sorted -integer $atomindex $e] < 0) \ 67 | || ([lsearch -sorted -integer $atomindex $f] < 0) \ 68 | || ([lsearch -sorted -integer $atomindex $g] < 0) \ 69 | || ([lsearch -sorted -integer $atomindex $h] < 0)} { 70 | lappend crosstermlist $crossterm 71 | } 72 | } 73 | molinfo $mol set crossterms [list $crosstermlist] 74 | } 75 | 76 | # reset crossterms to data in crosstermlist 77 | proc ::TopoTools::setcrosstermlist {sel crosstermlist} { 78 | 79 | set mol [$sel molid] 80 | set atomindex [$sel list] 81 | set newcrosstermlist {} 82 | 83 | # for backward compatibility with VMD versions before 1.9.2 84 | set ct {} 85 | if {[catch {molinfo $mol get crossterms} ct]} { 86 | vmdcon -warn "topotools: VMD [vmdinfo version] does not support crossterms" 87 | return -1 88 | } 89 | 90 | # set defaults 91 | set a -1; set b -1; set c -1; set d -1; set e -1; set f -1; set g -1; set h -1 92 | 93 | # preserve all crossterms definitions that are not contained in $sel 94 | foreach crossterm [join [molinfo $mol get crossterms]] { 95 | lassign $crossterm a b c d e f g h 96 | 97 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 98 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 99 | || ([lsearch -sorted -integer $atomindex $c] < 0) \ 100 | || ([lsearch -sorted -integer $atomindex $d] < 0) \ 101 | || ([lsearch -sorted -integer $atomindex $e] < 0) \ 102 | || ([lsearch -sorted -integer $atomindex $f] < 0) \ 103 | || ([lsearch -sorted -integer $atomindex $g] < 0) \ 104 | || ([lsearch -sorted -integer $atomindex $h] < 0)} { 105 | lappend crosstermlist $crossterm 106 | } 107 | } 108 | 109 | # append new ones, but only those contained in $sel 110 | foreach crossterm $crosstermlist { 111 | lassign $crossterm a b c d e f g h 112 | 113 | if {([lsearch -sorted -integer $atomindex $a] >= 0) \ 114 | && ([lsearch -sorted -integer $atomindex $b] >= 0) \ 115 | && ([lsearch -sorted -integer $atomindex $c] >= 0) \ 116 | && ([lsearch -sorted -integer $atomindex $d] >= 0) \ 117 | && ([lsearch -sorted -integer $atomindex $e] >= 0) \ 118 | && ([lsearch -sorted -integer $atomindex $f] >= 0) \ 119 | && ([lsearch -sorted -integer $atomindex $g] >= 0) \ 120 | && ([lsearch -sorted -integer $atomindex $h] >= 0)} { 121 | lappend newcrosstermlist $crossterm 122 | } 123 | } 124 | 125 | molinfo $mol set crossterms [list $newcrosstermlist] 126 | } 127 | 128 | # define a new crossterm or change an existing one. 129 | proc ::TopoTools::addcrossterm {mol id1 id2 id3 id4 id5 id6 id7 id8} { 130 | 131 | # for backward compatibility with VMD versions before 1.9.2 132 | set ct {} 133 | if {[catch {molinfo $mol get crossterms} ct]} { 134 | vmdcon -warn "topotools: VMD [vmdinfo version] does not support crossterms" 135 | return -1 136 | } 137 | 138 | if {[catch {atomselect $mol "index $id1 $id2 $id3 $id4 $id5 $id6 $id7 $id8"} sel]} { 139 | vmdcon -err "topology addcrossterm: Invalid atom indices: $sel" 140 | return 141 | } 142 | 143 | # canonicalize indices 144 | #Cross terms are just two adjacent dihedrals, and so we apply the canonicalization operations seperately. 145 | if {$id2 > $id3} { 146 | set t $id2 ; set id2 $id3 ; set id3 $t 147 | set t $id1 ; set id1 $id4 ; set id4 $t 148 | } 149 | if {$id6 > $id7} { 150 | set t $id6 ; set id2 $id7 ; set id7 $t 151 | set t $id5 ; set id5 $id8 ; set id8 $t 152 | } 153 | 154 | set crossterms [join [molinfo $mol get crossterms]] 155 | lappend crossterms [list $id1 $id2 $id3 $id4 $id5 $id6 $id7 $id8] 156 | $sel delete 157 | molinfo $mol set crossterms [list $crossterms] 158 | } 159 | 160 | # delete a crossterm. 161 | proc ::TopoTools::delcrossterm {mol id1 id2 id3 id4 id5 id6 id7 id8} { 162 | 163 | # for backward compatibility with VMD versions before 1.9.2 164 | set ct {} 165 | if {[catch {molinfo $mol get crossterms} ct]} { 166 | vmdcon -warn "topotools: VMD [vmdinfo version] does not support crossterms" 167 | return -1 168 | } 169 | 170 | if {[catch {atomselect $mol "index $id1 $id2 $id3 $id4 $id5 $id6 $id7 $id8"} sel]} { 171 | vmdcon -err "topology delcrossterm: Invalid atom indices: $sel" 172 | return 173 | } 174 | 175 | # canonicalize indices 176 | #Cross terms are just two adjacent dihedrals, and so we apply the canonicalization operations seperately. 177 | if {$id2 > $id3} { 178 | set t $id2 ; set id2 $id3 ; set id3 $t 179 | set t $id1 ; set id1 $id4 ; set id4 $t 180 | } 181 | if {$id6 > $id7} { 182 | set t $id6 ; set id2 $id7 ; set id7 $t 183 | set t $id5 ; set id5 $id8 ; set id8 $t 184 | } 185 | 186 | set newcrosstermlist {} 187 | foreach crossterm [join [molinfo $mol get crossterms]] { 188 | lassign $crossterm a b c d e f g h 189 | if { ($a != $id1) || ($b != $id2) || ($c != $id3) || ($d != $id4) || 190 | ($e != $id5) || ($f != $id6) || ($g != $id7) || ($h != $id8) } { 191 | lappend newcrosstermlist $crossterm 192 | } 193 | } 194 | $sel delete 195 | molinfo $mol set crossterms [list $newcrosstermlist] 196 | } 197 | -------------------------------------------------------------------------------- /topodihedrals.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # This file is part of TopoTools, a VMD package to simplify 3 | # manipulating bonds other topology related properties. 4 | # 5 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer 6 | # $Id: topodihedrals.tcl,v 1.12 2020/05/29 19:47:40 johns Exp $ 7 | 8 | # return info about dihedrals 9 | # we list and count only dihedrals that are entirely within the selection. 10 | proc ::TopoTools::dihedralinfo {infotype sel {flag none}} { 11 | 12 | set numdihedrals 0 13 | array set dihedraltypes {} 14 | set atomindex [$sel list] 15 | set dihedrallist {} 16 | 17 | foreach dihedral [join [molinfo [$sel molid] get dihedrals]] { 18 | lassign $dihedral t a b c d 19 | 20 | if {([lsearch -sorted -integer $atomindex $a] >= 0) \ 21 | && ([lsearch -sorted -integer $atomindex $b] >= 0) \ 22 | && ([lsearch -sorted -integer $atomindex $c] >= 0) \ 23 | && ([lsearch -sorted -integer $atomindex $d] >= 0) } { 24 | set dihedraltypes($t) 1 25 | incr numdihedrals 26 | lappend dihedrallist $dihedral 27 | } 28 | } 29 | switch $infotype { 30 | 31 | numdihedrals { return $numdihedrals } 32 | numdihedraltypes { return [array size dihedraltypes] } 33 | dihedraltypenames { return [lsort -ascii [array names dihedraltypes]] } 34 | getdihedrallist { return $dihedrallist } 35 | default { return "bug! shoot the programmer?"} 36 | } 37 | } 38 | 39 | # delete all contained dihedrals of the selection. 40 | proc ::TopoTools::cleardihedrals {sel} { 41 | set mol [$sel molid] 42 | set atomindex [$sel list] 43 | set dihedrallist {} 44 | 45 | foreach dihedral [join [molinfo $mol get dihedrals]] { 46 | lassign $dihedral t a b c d 47 | 48 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 49 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 50 | || ([lsearch -sorted -integer $atomindex $c] < 0) \ 51 | || ([lsearch -sorted -integer $atomindex $d] < 0) } { 52 | lappend dihedrallist $dihedral 53 | } 54 | } 55 | molinfo $mol set dihedrals [list $dihedrallist] 56 | } 57 | 58 | # reset dihedrals to data in dihedrallist 59 | proc ::TopoTools::setdihedrallist {sel dihedrallist} { 60 | 61 | set mol [$sel molid] 62 | set atomindex [$sel list] 63 | set newdihedrallist {} 64 | 65 | # set defaults 66 | set t unknown; set a -1; set b -1; set c -1; set d -1 67 | 68 | # preserve all dihedrals definitions that are not fully contained in $sel 69 | foreach dihedral [join [molinfo $mol get dihedrals]] { 70 | lassign $dihedral t a b c d 71 | 72 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 73 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 74 | || ([lsearch -sorted -integer $atomindex $c] < 0) \ 75 | || ([lsearch -sorted -integer $atomindex $d] < 0) } { 76 | lappend newdihedrallist $dihedral 77 | } 78 | } 79 | 80 | # append new ones, but only those contained in $sel 81 | foreach dihedral $dihedrallist { 82 | lassign $dihedral t a b c d 83 | 84 | if {([lsearch -sorted -integer $atomindex $a] >= 0) \ 85 | && ([lsearch -sorted -integer $atomindex $b] >= 0) \ 86 | && ([lsearch -sorted -integer $atomindex $c] >= 0) \ 87 | && ([lsearch -sorted -integer $atomindex $d] >= 0) } { 88 | lappend newdihedrallist $dihedral 89 | } 90 | } 91 | 92 | molinfo $mol set dihedrals [list $newdihedrallist] 93 | } 94 | 95 | # reset dihedrals to data in dihedrallist 96 | proc ::TopoTools::retypedihedrals {sel} { 97 | 98 | set mol [$sel molid] 99 | set dihedrallist [dihedralinfo getdihedrallist $sel] 100 | set atomtypes [$sel get type] 101 | set atomindex [$sel list] 102 | set newdihedrallist {} 103 | 104 | foreach dihedral $dihedrallist { 105 | lassign $dihedral type i1 i2 i3 i4 106 | 107 | set idx [lsearch -sorted -integer $atomindex $i1] 108 | set a [lindex $atomtypes $idx] 109 | set idx [lsearch -sorted -integer $atomindex $i2] 110 | set b [lindex $atomtypes $idx] 111 | set idx [lsearch -sorted -integer $atomindex $i3] 112 | set c [lindex $atomtypes $idx] 113 | set idx [lsearch -sorted -integer $atomindex $i4] 114 | set d [lindex $atomtypes $idx] 115 | 116 | if { ([string compare $b $c] > 0) \ 117 | || ( [string equal $b $c] && [string compare $a $d] > 0 ) } { 118 | set t $a; set a $d; set d $t 119 | set t $b; set b $c; set c $t 120 | set t $i1; set i1 $i4; set i4 $t 121 | set t $i2; set i2 $i3; set i3 $t 122 | } 123 | set type [join [list $a $b $c $d] "-"] 124 | 125 | lappend newdihedrallist [list $type $i1 $i2 $i3 $i4] 126 | } 127 | setdihedrallist $sel $newdihedrallist 128 | } 129 | 130 | 131 | # reset dihedrals to definitions derived from bonds. 132 | # this includes retyping of the dihedrals. 133 | proc ::TopoTools::guessdihedrals {sel} { 134 | 135 | set mol [$sel molid] 136 | set atomtypes [$sel get type] 137 | set atomindex [$sel list] 138 | set newdihedrallist {} 139 | 140 | set bondlist [bondinfo getbondlist $sel] 141 | set bonddata [$sel getbonds] 142 | 143 | # preserve all dihedrals definitions that are not fully contained in $sel 144 | foreach dihedral [join [molinfo $mol get dihedrals]] { 145 | lassign $dihedral t a b c d 146 | 147 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 148 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 149 | || ([lsearch -sorted -integer $atomindex $c] < 0) \ 150 | || ([lsearch -sorted -integer $atomindex $d] < 0) } { 151 | lappend newdihedrallist $dihedral 152 | } 153 | } 154 | 155 | # a topological dihedral is defined by a bond and atoms 156 | # bound to it that are not the bond itself 157 | foreach bond $bondlist { 158 | lassign $bond b1 b2 159 | set b1idx [lsearch -sorted -integer $atomindex $b1] 160 | set b1typ [lindex $atomtypes $b1idx] 161 | set b2idx [lsearch -sorted -integer $atomindex $b2] 162 | set b2typ [lindex $atomtypes $b2idx] 163 | foreach o1 [lindex $bonddata $b1idx] { 164 | foreach o2 [lindex $bonddata $b2idx] { 165 | if {($o1 == $b1) || ($o2 == $b1) || ($o1 == $b2) || ($o2 == $b2)} { 166 | continue 167 | } 168 | set o1idx [lsearch -sorted -integer $atomindex $o1] 169 | set o1typ [lindex $atomtypes $o1idx] 170 | set o2idx [lsearch -sorted -integer $atomindex $o2] 171 | set o2typ [lindex $atomtypes $o2idx] 172 | if { $o1 != $o2 } { 173 | if { ([string compare $b1typ $b2typ] > 0) \ 174 | || ( [string equal $b1typ $b2typ] 175 | && [string compare $o1typ $o2typ] > 0 ) } { 176 | set type [join [list $o2typ $b2typ $b1typ $o1typ] "-"] 177 | lappend newdihedrallist [list $type $o2 $b2 $b1 $o1] 178 | } else { 179 | set type [join [list $o1typ $b1typ $b2typ $o2typ] "-"] 180 | lappend newdihedrallist [list $type $o1 $b1 $b2 $o2] 181 | } 182 | } 183 | } 184 | } 185 | } 186 | setdihedrallist $sel $newdihedrallist 187 | } 188 | 189 | 190 | # define a new dihedral or change an existing one. 191 | proc ::TopoTools::adddihedral {mol id1 id2 id3 id4 {type unknown}} { 192 | if {[catch {atomselect $mol "index $id1 $id2 $id3 $id4"} sel]} { 193 | vmdcon -err "topology adddihedral: Invalid atom indices: $sel" 194 | return 195 | } 196 | 197 | # canonicalize indices 198 | if {$id2 > $id3} { 199 | set t $id2 ; set id2 $id3 ; set id3 $t 200 | set t $id1 ; set id1 $id4 ; set id4 $t 201 | } 202 | 203 | set dihedrals [join [molinfo $mol get dihedrals]] 204 | lappend dihedrals [list $type $id1 $id2 $id3 $id4] 205 | molinfo $mol set dihedrals [list $dihedrals] 206 | # this is not (yet) required 207 | $sel delete 208 | return 209 | } 210 | 211 | # delete a dihedral. 212 | proc ::TopoTools::deldihedral {mol id1 id2 id3 id4 {type unknown}} { 213 | if {[catch {atomselect $mol "index $id1 $id2 $id3 $id4"} sel]} { 214 | vmdcon -err "topology deldihedral: Invalid atom indices: $sel" 215 | return 216 | } 217 | 218 | # canonicalize indices 219 | if {$id2 > $id3} { 220 | set t $id2 ; set id2 $id3 ; set id3 $t 221 | set t $id1 ; set id1 $id4 ; set id4 $t 222 | } 223 | 224 | set newdihedrallist {} 225 | foreach dihedral [join [molinfo $mol get dihedrals]] { 226 | lassign $dihedral t a b c d 227 | if { ($a != $id1) || ($b != $id2) || ($c != $id3) || ($d != $id4) } { 228 | lappend newdihedrallist $dihedral 229 | } 230 | } 231 | molinfo $mol set dihedrals [list $newdihedrallist] 232 | # this is not (yet) required 233 | $sel delete 234 | return 235 | } 236 | -------------------------------------------------------------------------------- /topogromacs.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # This file is part of TopoTools, a VMD package to simplify 3 | # manipulating bonds and other topology related properties. 4 | # 5 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer 6 | # $Id: topogromacs.tcl,v 1.17 2022/10/04 16:12:40 johns Exp $ 7 | 8 | # high level subroutines for supporting gromacs topology files. 9 | # 10 | # by default writegmxtop will write an incomplete gromacs topology 11 | # format file that can be used in combination with a .gro/.pdb 12 | # coordinate file for generating .tpr files needed for some analysis 13 | # tools bundled with gromacs. this can be used to analyze simulation 14 | # data, that was not generated with gromacs and thus for which 15 | # no .tpr file exists. 16 | # 17 | # however, if CHARMM (format) parameter files are provided, a fully 18 | # functional topology file will be created, that is also capable of 19 | # running MD simulations. this functionality is written by Josh Vermaas 20 | # and documented in the publication at doi:10.1021/acs.jcim.6b00103 21 | # 22 | # IMPORTANT NOTE: this script differs from other topotools scripts in 23 | # that it does not check whether fragments are fully contained in the 24 | # selection. it will output a topology with exactly the same number of 25 | # atoms as the selection has. in case of partially contained fragments, 26 | # new molecule types will be created. 27 | # 28 | # Arguments: 29 | # filename = name of topology file 30 | # mol = molecule 31 | # sel = selection 32 | proc ::TopoTools::writegmxtop {filename mol sel {flags none}} { 33 | variable gmxciteme 34 | variable version 35 | 36 | if {[catch {open $filename w} fp]} { 37 | vmdcon -err "writegmxtop: problem opening gromacs topology file: $fp\n" 38 | return -1 39 | } 40 | 41 | # get a list of fragments, i.e. individual molecules 42 | set fragmap [lsort -integer -unique [$sel get fragment]] 43 | 44 | # user feedback has indicated we need to test for some 45 | # input conditions that will cause GROMACS to complain, 46 | # but not TopoGromacs. 47 | if { $flags != "" } { 48 | if {$gmxciteme} { 49 | vmdcon -info "======================" 50 | vmdcon -info "Please cite the following publication:" 51 | vmdcon -info "J.V. Vermaas et al., TopoGromacs: ..." 52 | vmdcon -info "http://dx.doi.org/10.1021/acs.jcim.6b00103" 53 | vmdcon -info "======================\n" 54 | set gmxciteme 0 55 | } 56 | 57 | # unfortunately, not all fragments represent individual 58 | # molecules. we need to check for this, and warn the user 59 | set savesegname [$sel get segname] 60 | set savechain [$sel get chain] 61 | # by making everything the same segment and chain, mol reanalyze 62 | # will determine fragments strictly from connectivity. 63 | $sel set segname "SEG" 64 | $sel set chain A 65 | mol reanalyze $mol 66 | set flatfragmap [lsort -integer -unique [$sel get fragment]] 67 | if { [llength $fragmap] > [llength $flatfragmap] } { 68 | vmdcon -err "writegmxtop: inconsistent fragment count in input molecule." 69 | vmdcon -info "There are connected components that have different segnames and/or chains, and thus are" 70 | vmdcon -info "classified into different fragments. This will cause problems for grompp." 71 | vmdcon -info "It is recommended that connected components have a single segname and chain, so that" 72 | vmdcon -info "VMD can recognize these connected components as a single molecule." 73 | return -1 74 | } 75 | $sel set segname $savesegname 76 | $sel set chain $savechain 77 | #Fragments can also be discontinuous, which while not a problem for TopoGromacs, it WILL result in a geometry 78 | #the user doesn't expect during simulation. So we check to make sure that fragment numbers are only increasing. 79 | set fraglist [$sel get fragment] 80 | set lowfrags [lrange $fraglist 0 end-1] 81 | set highfrags [lrange $fraglist 1 end] 82 | if { [lindex [lsort -real -increasing [vecsub $highfrags $lowfrags]] 0] < -0.5 } { 83 | vmdcon -err "writegmxtop: fragments are non-contiguous" 84 | vmdcon -info "Grompp reads input coordinates in order, and maps these directly onto atoms as" 85 | vmdcon -info "they are listed in the .top file. We have detected fragments out of numerical order" 86 | vmdcon -info "in the molecule, which will likely result in a misinterpretation of the input structure." 87 | vmdcon -info "Please try the following to generate a reordered structure, and use that as input:" 88 | vmdcon -info "set fragsellist \[list\]" 89 | vmdcon -info "set bigsel \[atomselect top \"not (water or ions)\"\]" 90 | vmdcon -info "foreach frag \[lsort -unique \[\$bigsel get fragment\]\] \{" 91 | vmdcon -info " set fsel \[atomselect top \"fragment \$frag\"\]" 92 | vmdcon -info " lappend fragsellist \$fsel" 93 | vmdcon -info "\}" 94 | vmdcon -info "set othersel \[atomselect top \"(water or ions)\"\]" 95 | vmdcon -info "lappend fragsellist \$othersel" 96 | vmdcon -info "set newmol \[::TopoTools::selections2mol \$fragsellist\]" 97 | vmdcon -info "animate write psf reordered.psf \$newmol" 98 | vmdcon -info "animate write pdb reordered.pdb \$newmol" 99 | return -1 100 | } 101 | set typechecklist [$sel get type] 102 | if { [$sel get name] == $typechecklist } { 103 | vmdcon -err "writegmxtop: atomnames are identical to atomtypes" 104 | vmdcon -info "TopoGromacs depends on the atomtypes to be set correctly to correctly map" 105 | vmdcon -info "parameters to specific atoms. However, the atomnames are identical to the" 106 | vmdcon -info "atomtypes in this molecule, which suggests that the type field was populated" 107 | vmdcon -info "by the atomname in a pdb file. Make sure the psf file is loaded before the pdb!" 108 | vmdcon -info "If the atomnames are intentionally identical to the atomtypes, rename an atom to" 109 | vmdcon -info "avoid this error." 110 | return -1 111 | } 112 | if { [lsearch -regexp $typechecklist {^[0-9]+$}] >= 0 } { 113 | vmdcon -err "writegmxtop: at least one atomtype is an integer and not a symbolic type name" 114 | vmdcon -info "TopoGromacs depends on the atomtypes to be given as alphanumeric types, as listed" 115 | vmdcon -info "in the parameter file, to correctly map parameters to specific atoms. At least" 116 | vmdcon -info "one atomtype here appear to be an integer, consistent with a CHARMM-formatted" 117 | vmdcon -info "psf file. TopoGromacs, however, requires an XPLOR-style psf file, which uses" 118 | vmdcon -info "alphanumeric atomtypes." 119 | return -1 120 | } 121 | } 122 | set typemap [lsort -ascii -unique [$sel get type]] 123 | set selstr [$sel text] 124 | # defaults for bond/angle/dihedral/improper functional form 125 | set btype 1 126 | set atype 1 127 | set dtype 1 128 | set itype 1 129 | set writepairs 0 130 | if { $flags == "" } { 131 | vmdcon -info "Generating an incomplete gromacs topology file: $filename" 132 | puts $fp "; INCOMPLETE gromacs topology generated from topotools." 133 | puts $fp "; WARNING| the purpose of this topology is to allow using the |WARNING" 134 | puts $fp "; WARNING| analysis tools from gromacs for non gromacs data. |WARNING" 135 | puts $fp "; WARNING| it cannot be used for a simulation. |WARNING" 136 | puts $fp "\n\[ defaults \]\n; nbfunc comb-rule gen-pairs fudgeLJ fudgeQQ" 137 | puts $fp "1 3 yes 0.5 0.5" 138 | puts $fp "\n\[ atomtypes \]\n; name bond_type mass charge ptype sigma epsilon" 139 | foreach t $typemap { 140 | if {[string is integer $t]} { 141 | puts $fp "type$t C 1.0 0.0 A 0.0 0.0" 142 | } else { 143 | puts $fp "$t C 1.0 0.0 A 0.0 0.0" 144 | } 145 | } 146 | puts $fp "\n\[ bondtypes \]\n; i j func b0 kb\n C C 1 0.13 1000.0 ; totally bogus" 147 | ; # puts $fp "\n\[ constrainttypes \]\n;" 148 | puts $fp "\n\[ angletypes \]\n; i j k func th0 cth\n C C C 1 109.500 100.0 ; totally bogus" 149 | puts $fp "\n\[ dihedraltypes \]\n; i j k l func coefficients\n C C C C 1 0.0 3 10.0 ; totally bogus" 150 | puts $fp "\n\[ cmaptypes \]\n; i j k l m func\n C C C C C 1 1 1 0; totally bogus" 151 | } else { 152 | vmdcon -info "Generating a real gromacs topology file: $filename" 153 | puts $fp "; This gromacs topology generated using topotools, and contains parameter" 154 | puts $fp "; information suitable for starting a simulation with gromacs. See " 155 | puts $fp "; doi:10.1021/acs.jcim.6b00103 for algorithmic details." 156 | writecharmmparams $fp $mol $sel [lindex $flags 0] 157 | set btype 1 158 | set atype 5 159 | set dtype 9 160 | set itype 2 161 | set writepairs 1 162 | } 163 | 164 | set fraglist {} 165 | set fragcntr {} 166 | set nlold {} 167 | set tlold {} 168 | set count 0 169 | foreach frag $fragmap { 170 | set fsel [atomselect $mol "(fragment $frag) and ($selstr)"] 171 | set nlist [$fsel get name] 172 | set tlist [$fsel get type] 173 | if {[listcmp $nlist $nlold] || [listcmp $tlist $tlold]} { 174 | vmdcon -info "Found new moleculetype: fragment \#$frag natoms=[$fsel num]" 175 | display update ui 176 | if {[llength $fraglist] > [llength $fragcntr]} { 177 | lappend fragcntr $count 178 | } 179 | puts $fp "" 180 | set iswater 0 181 | if { [$fsel num] == 3 && [lsort -unique [$fsel get resname]] == "TIP3" } { 182 | set molname "water[llength $fragcntr]" 183 | set iswater 1 184 | } else { 185 | set molname "molecule[llength $fragcntr]" 186 | } 187 | lappend fraglist $molname 188 | set count 1 189 | set nlold $nlist 190 | set tlold $tlist 191 | puts $fp "\n\[ moleculetype \]" 192 | puts $fp "; Name nrexcl\n$molname 3" 193 | puts $fp "\n\[ atoms \]" 194 | puts $fp "; nr type resnr residue atom cgnr charge mass" 195 | set atmmap [$fsel get index] 196 | set resmap [lsort -integer -unique [$fsel get residue]] 197 | set nr 1 198 | # for charge group handling 199 | set cgnr 1 200 | set cgnum 0 201 | set cgsum 0.0 202 | foreach idx [$fsel get index] type [$fsel get type] \ 203 | name [$fsel get name] residue [$fsel get residue] \ 204 | resname [$fsel get resname] charge [$fsel get charge] \ 205 | mass [$fsel get mass] { 206 | 207 | # assume that charge group atoms are consecutively 208 | # in the structure we are working on. gromacs also 209 | # imposes a 32 atom limit on charge groups that we 210 | # have to honor. to allow for rounding erros we assume 211 | # that 0.01 is zero. 212 | set cgcut 0.01 213 | set cgmax 30 214 | set cgsum [expr {$cgsum + $charge}] 215 | incr cgnum 216 | if { (($cgnum > 1) && (abs($cgsum - floor($cgsum + 0.5*$cgcut)) < $cgcut)) || ($cgnum > $cgmax) } { 217 | set cgnum 0 218 | incr cgnr 219 | set cgsum 0.0 220 | } 221 | 222 | # fix up some data that gromacs cannok grok 223 | if {[string is integer $type]} {set type "type$type"} 224 | if {[string is integer $resname]} {set resname "RES$resname"} 225 | set resid [lsearch -sorted -integer $resmap $residue] 226 | incr resid 227 | puts $fp [format "% 6d %11s % 6d %8s %6s % 6d %10.4f %10.4f" \ 228 | $nr $type $resid $resname $name $cgnr $charge $mass ] 229 | incr nr 230 | } 231 | # end of loop over atoms 232 | if { $iswater } { 233 | puts $fp "\n\[ settles \]\n; i j funct length\n1 1 0.09572 0.15139\n\n\[ exclusions \]\n1 2 3\n2 1 3\n3 1 2" 234 | } else { 235 | if { $writepairs } { 236 | #Need to find the 1-4 pairs. For some dumb reason, grompp doesn't do this for you. 237 | set list [get14pairs $fsel] 238 | if {[llength $list]} { 239 | puts $fp "\n\[ pairs \]\n; ai aj func" 240 | foreach pair $list { 241 | lassign $pair i j 242 | set i [lsearch -sorted -integer $atmmap $i] 243 | set j [lsearch -sorted -integer $atmmap $j] 244 | incr i; incr j 245 | puts $fp "$i $j 1" 246 | } 247 | } 248 | } 249 | 250 | set list [bondinfo getbondlist $fsel none] 251 | if {[llength $list]} { 252 | puts $fp "\n\[ bonds \]\n; i j func" 253 | foreach b $list { 254 | lassign $b i j 255 | set i [lsearch -sorted -integer $atmmap $i] 256 | set j [lsearch -sorted -integer $atmmap $j] 257 | incr i; incr j 258 | puts $fp "$i $j $btype" 259 | } 260 | } 261 | 262 | set list [angleinfo getanglelist $fsel] 263 | if {[llength $list] > 0} { 264 | puts $fp "\n\[ angles \]\n; i j k func" 265 | foreach b $list { 266 | lassign $b t i j k 267 | set i [lsearch -sorted -integer $atmmap $i] 268 | set j [lsearch -sorted -integer $atmmap $j] 269 | set k [lsearch -sorted -integer $atmmap $k] 270 | incr i; incr j; incr k 271 | puts $fp "$i $j $k $atype" 272 | } 273 | } 274 | 275 | set list [dihedralinfo getdihedrallist $fsel] 276 | if {[llength $list] > 0} { 277 | puts $fp "\n\[ dihedrals \]\n; i j k l func" 278 | foreach b $list { 279 | lassign $b t i j k l 280 | set i [lsearch -sorted -integer $atmmap $i] 281 | set j [lsearch -sorted -integer $atmmap $j] 282 | set k [lsearch -sorted -integer $atmmap $k] 283 | set l [lsearch -sorted -integer $atmmap $l] 284 | incr i ; incr j; incr k ; incr l 285 | puts $fp "$i $j $k $l $dtype" 286 | } 287 | } 288 | 289 | set list [improperinfo getimproperlist $fsel] 290 | if {[llength $list] > 0} { 291 | puts $fp "\n\[ dihedrals \]\n; i j k l func" 292 | foreach b $list { 293 | lassign $b t i j k l 294 | set i [lsearch -sorted -integer $atmmap $i] 295 | set j [lsearch -sorted -integer $atmmap $j] 296 | set k [lsearch -sorted -integer $atmmap $k] 297 | set l [lsearch -sorted -integer $atmmap $l] 298 | incr i ; incr j; incr k ; incr l 299 | puts $fp "$i $j $k $l $itype" 300 | } 301 | } 302 | set list [crossterminfo getcrosstermlist $fsel] 303 | if {[llength $list] > 0} { 304 | puts $fp "\n\[ cmap \]\n; ai aj ak al am funct" 305 | foreach b $list { 306 | lassign $b i j k l x y z m 307 | set i [lsearch -sorted -integer $atmmap $i] 308 | set j [lsearch -sorted -integer $atmmap $j] 309 | set k [lsearch -sorted -integer $atmmap $k] 310 | set l [lsearch -sorted -integer $atmmap $l] 311 | set m [lsearch -sorted -integer $atmmap $m] 312 | incr i ; incr j; incr k ; incr l ; incr m 313 | puts $fp "$i $j $k $l $m 1" 314 | } 315 | } 316 | } 317 | } else { 318 | incr count 319 | } 320 | $fsel delete 321 | } 322 | lappend fragcntr $count 323 | 324 | puts $fp "\n\[ system \]\n; Name\nvmdmolecule$mol\n" 325 | puts $fp "\n\[ molecules \]\n; Compound \#mols" 326 | vmdcon -info "Found [llength $fraglist] moleculetypes." 327 | foreach name $fraglist num $fragcntr { 328 | vmdcon -info "$num x $name" 329 | puts $fp "$name $num" 330 | } 331 | close $fp 332 | return 333 | } 334 | 335 | proc ::TopoTools::writegmxLJprm {fp lj mass types} { 336 | variable kjinkcal 337 | puts $fp "\n\[ atomtypes \]" 338 | puts $fp "; type atnum mass charge ptype sigma epsilon" 339 | set twoonesixth [expr { pow(2.0, 1.0/6)}] 340 | 341 | foreach dat $lj { 342 | 343 | set type [lindex $dat 0] 344 | if {[lsearch -exact $types $type] != -1} { 345 | # Sigma in gromacs is defined as the radius where the potential 346 | # crosses zero and not where it is minimal (rmin) as in CHARMM. 347 | # also it is given in nanometers and not angstrom. 348 | set sigma [expr {[lindex $dat 3] * .2 / $twoonesixth}] 349 | set epsilon [expr {abs([lindex $dat 2] * $kjinkcal) }] 350 | set m [dict get $mass $type] 351 | set idx [ptefrommass $m] 352 | puts $fp [format "%8s %3d %10.4f 0.000 A %.12f %.5f" $type $idx $m $sigma $epsilon] 353 | } 354 | } 355 | puts $fp "\n\[ pairtypes \]" 356 | puts $fp "; i j func sigma epsilon ; THESE ARE 1-4 INTERACTIONS, NOT NBFIX" 357 | # Sigma in gromacs is defined as the radius where the potential 358 | # crosses zero and not where it is minimal (rmin) as in CHARMM. 359 | # also it is given in nanometers and not angstrom. 360 | foreach dat $lj { 361 | if {[llength $dat] == 7} { 362 | set type1 [lindex $dat 0] 363 | if {[lsearch -exact $types $type1] != -1} { 364 | set sigma1 [expr {[lindex $dat 6] * .2 / $twoonesixth}] 365 | set epsilon1 [expr {abs([lindex $dat 5] * $kjinkcal) }] 366 | foreach dat2 $lj { 367 | set type2 [lindex $dat2 0] 368 | if {[lsearch -exact $types $type2] != -1} { 369 | if {[llength $dat2] == 7} { 370 | set sigma2 [expr {[lindex $dat2 6] * .2 / $twoonesixth}] 371 | set epsilon2 [expr {abs([lindex $dat2 5] * $kjinkcal) }] 372 | } else { 373 | set sigma2 [expr {[lindex $dat2 3] * .2 / $twoonesixth}] 374 | set epsilon2 [expr {abs([lindex $dat2 2] * $kjinkcal) }] 375 | } 376 | puts $fp [format "%8s %8s 1 %.12f %.12f" $type1 $type2 \ 377 | [expr {0.5 * ($sigma1 + $sigma2)}] \ 378 | [expr {sqrt($epsilon1 * $epsilon2)}]] 379 | } 380 | } 381 | } 382 | } 383 | } 384 | } 385 | 386 | proc ::TopoTools::writegmxbondprm {fp bonds types} { 387 | variable kjinkcal 388 | puts $fp "\n\[ bondtypes \]" 389 | puts $fp "; i j func b0 kb" 390 | foreach bond $bonds { 391 | lassign $bond type1 type2 k b0 392 | if {[findInTypes $types [list $type1 $type2]]} { 393 | puts $fp [format "%8s %8s 1 %.8f %.2f" $type1 $type2 \ 394 | [expr {$b0 * 0.1}] \ 395 | [expr {$k * 2 * $kjinkcal / (0.1 * 0.1)}] ] 396 | } 397 | } 398 | } 399 | 400 | proc ::TopoTools::writegmxangleprm {fp angles types} { 401 | variable kjinkcal 402 | puts $fp "\n\[ angletypes \]" 403 | puts $fp "; i j k func theta ktheta ub0 kub" 404 | foreach angle $angles { 405 | lassign $angle type1 type2 type3 ktheta theta0 kub s0 406 | if {[findInTypes $types [list $type1 $type2 $type3]]} { 407 | puts $fp [format "%8s %8s %8s 5 %.6f %.6f %.8f %10.2f" \ 408 | $type1 $type2 $type3 $theta0 \ 409 | [expr {2 * $kjinkcal * $ktheta}] \ 410 | [expr {$s0 * 0.1}] \ 411 | [expr {$kub * 2 * $kjinkcal / (0.1 * 0.1)}]] 412 | } 413 | } 414 | } 415 | 416 | proc ::TopoTools::writegmxdihedralprm {fp dihedrals types} { 417 | variable kjinkcal 418 | puts $fp "\n\[ dihedraltypes \]" 419 | set delaywrite [list ] 420 | puts $fp "; i j k l func phi0 kphi n ; These are the proper dihedrals." 421 | foreach dihedral $dihedrals { 422 | lassign $dihedral t1 t2 t3 t4 k n delta 423 | if {[findInTypes $types [list $t1 $t2 $t3 $t4]]} { 424 | if { [string equal $t1 X] || [string equal $t4 X] || [string equal $t2 X] || [string equal $t3 X]} { 425 | lappend delaywrite [format "%8s %8s %8s %8s 9 %8.3f %12.6f %d" \ 426 | $t1 $t2 $t3 $t4 $delta [expr {$k * $kjinkcal}] $n] 427 | } else { 428 | puts $fp [format "%8s %8s %8s %8s 9 %8.3f %12.6f %d" \ 429 | $t1 $t2 $t3 $t4 $delta [expr {$k * $kjinkcal}] $n] 430 | } 431 | } 432 | } 433 | #Gromacs dihedral type parser isn't very clever. It looks for the first matching dihedral, 434 | #therefore wildcard dihedrals must come last. 435 | foreach element $delaywrite { 436 | puts $fp $element 437 | } 438 | } 439 | 440 | proc ::TopoTools::writegmximproperprm {fp impropers types} { 441 | variable kjinkcal 442 | puts $fp "\n\[ dihedraltypes \]" 443 | set delaywrite [list ] 444 | puts $fp "; i j k l func phi0 kphi ; These are the improper dihedrals." 445 | foreach dihedral $impropers { 446 | lassign $dihedral t1 t2 t3 t4 k n delta 447 | if {[findInTypes $types [list $t1 $t2 $t3 $t4]]} then { 448 | if { [string equal $t1 X] || [string equal $t4 X] || [string equal $t2 X] || [string equal $t3 X]} { 449 | lappend delaywrite [format "%8s %8s %8s %8s 2 %8.3f %12.6f" \ 450 | $t1 $t2 $t3 $t4 $delta [expr {2 * $k * $kjinkcal}]] 451 | } else { 452 | puts $fp [format "%8s %8s %8s %8s 2 %8.3f %12.6f" \ 453 | $t1 $t2 $t3 $t4 $delta [expr {2 * $k * $kjinkcal}]] 454 | } 455 | } 456 | } 457 | #Gromacs dihedral type parser isn't very clever. It looks for the first matching dihedral, 458 | #therefore wildcard dihedrals must come last. 459 | foreach element $delaywrite { 460 | puts $fp $element 461 | } 462 | } 463 | 464 | proc ::TopoTools::writegmxcmapprm {fp cmap types} { 465 | variable kjinkcal 466 | puts $fp "\n\[ cmaptypes \]" 467 | foreach term $cmap { 468 | set rest [lassign $term t1 t2 t3 t4 t5 n] 469 | if {[findInTypes $types [list $t1 $t2 $t3 $t4 $t5]]} then { 470 | puts $fp [format "%s %s %s %s %s 1 %d %d\\" $t1 $t2 $t3 $t4 $t5 $n $n] 471 | for {set i 0} {$i < [llength $rest]} { incr i } { 472 | if {[expr {$i % 10}] == 9} { 473 | puts $fp [format "%.8f\\" [expr {$kjinkcal * [lindex $rest $i]}]] 474 | } else { 475 | puts -nonewline $fp [format "%.8f " \ 476 | [expr {$kjinkcal * [lindex $rest $i]}]] 477 | } 478 | } 479 | #Don't forget to put a newline after the last of the 576. 480 | puts $fp "" 481 | } 482 | } 483 | } 484 | 485 | proc ::TopoTools::writegmxnbfixprm {fp nbfix types} { 486 | variable kjinkcal 487 | puts $fp "\n\[ nonbond_params \]" 488 | puts $fp ";type1 type2 1 sigma epsilon" 489 | set twoonesixth [expr { pow(2.0, 1.0/6)}] 490 | foreach term $nbfix { 491 | lassign $term t1 t2 epsilon rmin 492 | if {[findInTypes $types [list $t1 $t2]]} { 493 | puts $fp [format "%8s %8s 1 %.12f %.12f" $t1 $t2 \ 494 | [expr {$rmin * 0.1 / $twoonesixth}] \ 495 | [expr {abs($epsilon * $kjinkcal)}]] 496 | } 497 | } 498 | } 499 | 500 | proc ::TopoTools::writecharmmparams {fp mol sel filelist} { 501 | puts $fp "\[ defaults \]\n; nbfunc comb-rule gen-pairs fudgeLJ fudgeQQ" 502 | # This is comb-rule 2, which sums sigmas and multiplies epsilons. 503 | #See section 5.3.2 of the gromacs manual. 504 | puts $fp "1 2 yes 1.0 1.0" 505 | set cmap [list ] 506 | set bonds [list ] 507 | set angles [list ] 508 | set dihedrals [list ] 509 | set impropers [list ] 510 | set mass [dict create] 511 | set lj [list ] 512 | set nbfix [list ] 513 | foreach paramfile $filelist { 514 | set fin [open $paramfile r] 515 | set fdat [read $fin] 516 | close $fin 517 | set data [split $fdat "\n"] 518 | foreach line $data { 519 | # Try to find a comment character. 520 | # If found, discard the remainder of the line. 521 | set idx [string first ! $line] 522 | # Subtract one here, since if found, we don't 523 | # want to include it in the substring. 524 | incr idx -1 525 | if {$idx < 0} { 526 | set idx end 527 | } 528 | set l [string range $line 0 $idx] 529 | # Split based on whitespace. 530 | set ss [regexp -inline -all -- {\S+} $l] 531 | # Fit the split to one of the (type aware) parameter parsings, 532 | # ignore it if it doesn't fit. 533 | switch [llength $ss] { 534 | 4 { 535 | #Length 4: Bonds, LJ, NBFIX, certain CMAP data lines, MASS 536 | #CMAP 537 | if {[string is double [lindex $ss 0]] && 538 | [string is double [lindex $ss 1]] && 539 | [string is double [lindex $ss 2]] && 540 | [string is double [lindex $ss 3]]} then { 541 | set cmaptmp [concat $cmaptmp $ss] 542 | if {[llength $cmaptmp] == [expr {6 + [lindex $cmaptmp 5] * [lindex $cmaptmp 5]}]} { 543 | lappend cmap $cmaptmp 544 | } 545 | #Bonds 546 | } elseif {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 547 | [string is alnum [lindex $ss 1]] && [string is ascii [lindex $ss 1]] && 548 | [string is double [lindex $ss 2]] && [lindex $ss 2] >= 0 && 549 | [string is double [lindex $ss 3]]} then { 550 | lappend bonds $ss 551 | #NBFIX 552 | } elseif {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 553 | [string is alnum [lindex $ss 1]] && [string is ascii [lindex $ss 1]] && 554 | [string is double [lindex $ss 2]] && [lindex $ss 2] < 0 && 555 | [string is double [lindex $ss 3]]} then { 556 | lappend nbfix $ss 557 | #LJ 558 | } elseif {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 559 | [string is double [lindex $ss 1]] && 560 | [string is double [lindex $ss 2]] && [lindex $ss 2] < 0 && 561 | [string is double [lindex $ss 3]]} then { 562 | lappend lj $ss 563 | #MASS 564 | } elseif {[lindex $ss 0] == "MASS" && 565 | [string is integer [lindex $ss 1]] && 566 | [string is alnum [lindex $ss 2]] && [string is ascii [lindex $ss 2]] && 567 | [string is double [lindex $ss 3]]} then { 568 | dict set mass [lindex $ss 2] [lindex $ss 3] 569 | } 570 | } 571 | 572 | 5 { 573 | #Length 5: Angles, CMAP data lines. Also some mass lines that are formatted for top files. 574 | #CMAP 575 | if {[string is double [lindex $ss 0]] && 576 | [string is double [lindex $ss 1]] && 577 | [string is double [lindex $ss 2]] && 578 | [string is double [lindex $ss 3]] && 579 | [string is double [lindex $ss 4]]} then { 580 | set cmaptmp [concat $cmaptmp $ss] 581 | #Angles 582 | } elseif {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 583 | [string is alnum [lindex $ss 1]] && [string is ascii [lindex $ss 1]] && 584 | [string is alnum [lindex $ss 2]] && [string is ascii [lindex $ss 2]] && 585 | [string is double [lindex $ss 3]] && 586 | [string is double [lindex $ss 4]]} then { 587 | lappend ss 0.0 0.0 588 | lappend angles $ss 589 | } elseif {[lindex $ss 0] == "MASS" && 590 | [string is integer [lindex $ss 1]] && 591 | [string is alnum [lindex $ss 2]] && [string is ascii [lindex $ss 2]] && 592 | [string is double [lindex $ss 3]] && 593 | [string is alpha [lindex $ss 4]] && [string is ascii [lindex $ss 4]]} then { 594 | dict set mass [lindex $ss 2] [lindex $ss 3] 595 | } 596 | } 597 | 7 { 598 | #Length 7: Angles (w/UB), dihedrals, impropers, nonbonded with 1-4 seperate. 599 | #Angles 600 | if {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 601 | [string is alnum [lindex $ss 1]] && [string is ascii [lindex $ss 1]] && 602 | [string is alnum [lindex $ss 2]] && [string is ascii [lindex $ss 2]] && 603 | [string is double [lindex $ss 3]] && 604 | [string is double [lindex $ss 4]] && 605 | [string is double [lindex $ss 5]] && 606 | [string is double [lindex $ss 6]]} then { 607 | lappend angles $ss 608 | #Dihedrals 609 | } elseif {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 610 | [string is alnum [lindex $ss 1]] && [string is ascii [lindex $ss 1]] && 611 | [string is alnum [lindex $ss 2]] && [string is ascii [lindex $ss 2]] && 612 | [string is alnum [lindex $ss 3]] && [string is ascii [lindex $ss 3]] && 613 | [string is double [lindex $ss 4]] && 614 | [string is integer [lindex $ss 5]] && [expr {[lindex $ss 5] > 0}] && 615 | [string is double [lindex $ss 6]]} then { 616 | lappend dihedrals $ss 617 | #Impropers 618 | } elseif {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 619 | [string is alnum [lindex $ss 1]] && [string is ascii [lindex $ss 1]] && 620 | [string is alnum [lindex $ss 2]] && [string is ascii [lindex $ss 2]] && 621 | [string is alnum [lindex $ss 3]] && [string is ascii [lindex $ss 3]] && 622 | [string is double [lindex $ss 4]] && 623 | [string is integer [lindex $ss 5]] && [lindex $ss 5] == 0 && 624 | [string is double [lindex $ss 6]]} then { 625 | lappend impropers $ss 626 | #Nonbonded 627 | } elseif {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 628 | [string is double [lindex $ss 1]] && 629 | [string is double [lindex $ss 2]] && 630 | [string is double [lindex $ss 3]] && 631 | [string is double [lindex $ss 4]] && 632 | [string is double [lindex $ss 5]] && 633 | [string is double [lindex $ss 6]]} then { 634 | lappend lj $ss 635 | } 636 | } 637 | 9 { 638 | #Length 9: CMAP declarations 639 | if {[string is alnum [lindex $ss 0]] && [string is ascii [lindex $ss 0]] && 640 | [string is alnum [lindex $ss 1]] && [string is ascii [lindex $ss 1]] && 641 | [string is alnum [lindex $ss 2]] && [string is ascii [lindex $ss 2]] && 642 | [string is alnum [lindex $ss 3]] && [string is ascii [lindex $ss 3]] && 643 | [string is alnum [lindex $ss 4]] && [string is ascii [lindex $ss 4]] && 644 | [string is alnum [lindex $ss 5]] && [string is ascii [lindex $ss 5]] && 645 | [string is alnum [lindex $ss 6]] && [string is ascii [lindex $ss 6]] && 646 | [string is alnum [lindex $ss 7]] && [string is ascii [lindex $ss 7]] && 647 | [string is integer [lindex $ss 8]]} then { 648 | set cmaptmp [list [lindex $ss 0] [lindex $ss 1] [lindex $ss 2] [lindex $ss 3] [lindex $ss 7] [lindex $ss 8]] 649 | } 650 | } 651 | } 652 | } 653 | } 654 | set types [lsort -unique [$sel get type]] 655 | #In case only a parameter file without MASS lines is passed, 656 | #lookup what the masses should be based on what exists in the current molecule. 657 | foreach type $types { 658 | if { ! [dict exists $mass $type]} { 659 | set subset [atomselect $mol "type \"$type\""] 660 | dict set mass $type [lindex [$subset get mass] 0] 661 | $subset delete 662 | } 663 | } 664 | #Write the parameter lists to the output file. 665 | writegmxLJprm $fp $lj $mass $types 666 | writegmxbondprm $fp $bonds $types 667 | writegmxangleprm $fp $angles $types 668 | writegmxdihedralprm $fp $dihedrals $types 669 | writegmximproperprm $fp $impropers $types 670 | writegmxcmapprm $fp $cmap $types 671 | writegmxnbfixprm $fp $nbfix $types 672 | } 673 | 674 | 675 | proc ::TopoTools::get14pairs { sel } { 676 | set bondtable [$sel getbonds] 677 | set excl12 [list ] 678 | set excl13 [list ] 679 | set excl14 [list ] 680 | set idxlist [$sel get index] 681 | foreach i [$sel get index] { 682 | set bonds [lsort [lindex $bondtable [lsearch -exact $idxlist $i]]] 683 | foreach j $bonds { 684 | set bondj [lsort [lindex $bondtable [lsearch -exact $idxlist $j]]] 685 | #To avoid making these lists blow up, we do simple comparisons here so we 686 | #only add them to the list once. 687 | if { $i < $j } { 688 | lappend excl12 [list $i $j] 689 | foreach k $bonds { 690 | if {$k < $j} { 691 | lappend excl13 [list $k $j] 692 | } 693 | if {$k != $j} { 694 | foreach l $bondj { 695 | if {$l != $i && $l != $k} { 696 | if { $k < $l } { 697 | lappend excl14 [list $k $l] 698 | } else { 699 | lappend excl14 [list $l $k] 700 | } 701 | } 702 | } 703 | } 704 | } 705 | } else { 706 | #i < j not needed for angle/1-3 interactions. 707 | foreach k $bonds { 708 | if {$k < $j} { 709 | lappend excl13 [list $k $j] 710 | } 711 | } 712 | } 713 | } 714 | } 715 | set excl123 [concat $excl12 $excl13] 716 | set retlist [list ] 717 | #For cyclic systems (<6 membered rings), it is possible that elements determined by 718 | #bonding alone would be excluded from the 1-4 list since they are really 1-2 or 1-3 pairs. 719 | #Also, for 6-membered rings, the naive implementation will pick up pairs across the rings twice (once in each direction around the ring). 720 | #The second check makes sure that those pairs are only included once as they should be, 721 | #otherwise those terms are included twice in the pairlist, which is incorrect. 722 | foreach pair $excl14 { 723 | if {[lsearch -exact $excl123 $pair] == -1 && [lsearch -exact $retlist $pair] == -1} { 724 | lappend retlist $pair 725 | } 726 | } 727 | return $retlist 728 | } 729 | -------------------------------------------------------------------------------- /topohelpers.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # TopoTools, a VMD package to simplify manipulating bonds 3 | # other topology related properties in VMD. 4 | # 5 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer 6 | # $Id: topohelpers.tcl,v 1.11 2020/05/29 19:47:40 johns Exp $ 7 | 8 | # some (small) helper functions 9 | 10 | # compare two lists element by element. 11 | # return 0 if they are identical, or 1 if not. 12 | proc ::TopoTools::listcmp {a b} { 13 | if {[llength $a] != [llength $b]} { 14 | return 1 15 | } 16 | foreach aa $a bb $b { 17 | if {![string equal $aa $bb]} { 18 | return 1 19 | } 20 | } 21 | return 0 22 | } 23 | 24 | # angle definition list comparison function 25 | proc ::TopoTools::compareangles {a b} { 26 | lassign $a at a1 a2 a3 27 | lassign $b bt b1 b2 b3 28 | 29 | # canonicalize 30 | if {$a1 > $a3} { set t $a1 ; set a1 $a3; set a3 $t } 31 | if {$b1 > $b3} { set t $b1 ; set b1 $b3; set b3 $t } 32 | 33 | # compare. first center, then left, then right atom, finally type. 34 | if {$a2 < $b2} { 35 | return -1 36 | } elseif {$a2 > $b2} { 37 | return 1 38 | } else { 39 | if {$a1 < $b1} { 40 | return -1 41 | } elseif {$a1 > $b1} { 42 | return 1 43 | } else { 44 | if {$a3 < $b3} { 45 | return -1 46 | } elseif {$a3 > $b3} { 47 | return 1 48 | } else { 49 | return [string compare $at $bt] 50 | } 51 | } 52 | } 53 | } 54 | 55 | # dihedral definition list comparison function 56 | proc ::TopoTools::comparedihedrals {a b} { 57 | lassign $a at a1 a2 a3 a4 58 | lassign $b bt b1 b2 b3 b4 59 | 60 | # canonicalize 61 | if {($a2 > $a3) || (($a2 == $a3) && ($a1 > $a4))} { 62 | set t $a1; set a1 $a4; set a4 $t 63 | set t $a2; set a2 $a3; set a3 $t 64 | } 65 | if {($b2 > $b3) || (($b2 == $b3) && ($b1 > $b4))} { 66 | set t $b1; set b1 $b4; set b4 $t 67 | set t $b2; set b2 $b3; set b3 $t 68 | } 69 | # compare. first center bond, then outside atoms, then type. start from left. 70 | if {$a2 < $b2} { 71 | return -1 72 | } elseif {$a2 > $b2} { 73 | return 1 74 | } else { 75 | if {$a3 < $b3} { 76 | return -1 77 | } elseif {$a3 > $b3} { 78 | return 1 79 | } else { 80 | if {$a1 < $b1} { 81 | return -1 82 | } elseif {$a1 > $b1} { 83 | return 1 84 | } else { 85 | if {$a4 < $b4} { 86 | return -1 87 | } elseif {$a4 > $b4} { 88 | return 1 89 | } else { 90 | return [string compare $at $bt] 91 | } 92 | } 93 | } 94 | } 95 | } 96 | 97 | # improper dihedral definition list comparison function 98 | # this assumes that the improper definition follows the 99 | # usual convention that the 3rd atom is connected to the 100 | # other three via bonds. 101 | proc ::TopoTools::compareimpropers {a b} { 102 | lassign $a at a1 a2 a3 a4 103 | lassign $b bt b1 b2 b3 b4 104 | 105 | # canonicalize. same as in guessdihedrals. 106 | if {($a1 > $a2)} { set t $a1; set a1 $a2; set a2 $t } 107 | if {($a2 > $a3)} { set t $a2; set a2 $a3; set a3 $t } 108 | if {($a1 > $a2)} { set t $a1; set a1 $a2; set a2 $t } 109 | if {($b1 > $b2)} { set t $b1; set b1 $b2; set b2 $t } 110 | if {($b2 > $b3)} { set t $b2; set b2 $b3; set b3 $t } 111 | if {($b1 > $b2)} { set t $b1; set b1 $b2; set b2 $t } 112 | 113 | # compare. first center atom, then outside atoms, then type. start from left. 114 | if {$a3 < $b3} { 115 | return -1 116 | } elseif {$a3 > $b3} { 117 | return 1 118 | } else { 119 | if {$a1 < $b1} { 120 | return -1 121 | } elseif {$a1 > $b1} { 122 | return 1 123 | } else { 124 | if {$a2 < $b2} { 125 | return -1 126 | } elseif {$a2 > $b2} { 127 | return 1 128 | } else { 129 | if {$a4 < $b4} { 130 | return -1 131 | } elseif {$a4 > $b4} { 132 | return 1 133 | } else { 134 | return [string compare $at $bt] 135 | } 136 | } 137 | } 138 | } 139 | } 140 | 141 | # sort angle/dihedral/improper list and remove duplicates 142 | proc ::TopoTools::sortsomething {what sel} { 143 | 144 | switch $what { 145 | angle { 146 | setanglelist $sel [lsort -unique -command compareangles \ 147 | [angleinfo getanglelist $sel]] 148 | } 149 | dihedral { 150 | setdihedrallist $sel [lsort -unique -command comparedihedrals \ 151 | [dihedralinfo getdihedrallist $sel]] 152 | } 153 | improper { 154 | setimproperlist $sel [lsort -unique -command compareimpropers \ 155 | [improperinfo getimproperlist $sel]] 156 | } 157 | } 158 | } 159 | 160 | # emulate the behavior of loading a molecule through 161 | # the regular "mol new" command. the options $selmod 162 | # argument allows to append an additional modified to 163 | # the selection, e.g. 'user > 0.1' for variable number 164 | # particle xyz trajectories. 165 | proc ::TopoTools::adddefaultrep {mol {selmod none}} { 166 | mol color [mol default color] 167 | mol rep [mol default style] 168 | if {[string equal $selmod none]} { 169 | mol selection [mol default selection] 170 | } else { 171 | mol selection "([mol default selection]) and $selmod" 172 | } 173 | mol material [mol default material] 174 | mol addrep $mol 175 | display resetview 176 | } 177 | 178 | # guess the atomic number in the peridic table from the mass 179 | proc ::TopoTools::ptefrommass {{amass 0.0}} { 180 | variable masses 181 | variable masswarn 182 | 183 | set idx 0 184 | foreach m $masses { 185 | # this catches most cases. 186 | # we check the few exceptions later. 187 | if {[expr abs($amass-$m)] < 0.65} { 188 | set idx [lsearch $masses $m] 189 | } 190 | } 191 | # this is a hydrogen or deuterium and we flag it as hydrogen. 192 | if {($amass > 0.0) && ($amass < 2.2)} { 193 | set idx 1 194 | } 195 | # Differentiate between Bismutium and Polonium. 196 | # The normal search will detect Polonium. 197 | if {($amass > 208.09) && ($amass < 208.99)} { 198 | if {$masswarn > 0} { 199 | vmdcon -warn "topotools: Bismutium detected. Cannot assign element correctly due to atomselect limitation" 200 | set masswarn 0 201 | } 202 | set idx 83 203 | } 204 | # Differentiate between Cobalt and Nickel 205 | # The normal search will detect Nickel. 206 | if {($amass < 61.24) && ($amass > 58.8133)} { 207 | set idx 27 208 | } 209 | return $idx 210 | } 211 | 212 | # This exists to eliminate unneeded parameters from CHARMM parameter files. 213 | # There are some oddly formatted files (particularly older ones) that will 214 | # give parameters for atoms that aren't given LJ parameters. 215 | # Naturally, this is a problem, so we don't include parameters 216 | # for atomtypes not present in the psf or that include a wildcard. 217 | proc ::TopoTools::findInTypes {types l} { 218 | foreach element $l { 219 | if { [lsearch $types $element] == -1 && $element != "X"} { 220 | return 0 221 | } 222 | } 223 | return 1 224 | } 225 | -------------------------------------------------------------------------------- /topoimpropers.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # This file is part of TopoTools, a VMD package to simplify 3 | # manipulating bonds other topology related properties. 4 | # 5 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer 6 | # $Id: topoimpropers.tcl,v 1.12 2020/05/29 19:47:40 johns Exp $ 7 | 8 | # return info about impropers 9 | # we list and count only impropers that are entirely within the selection. 10 | proc ::TopoTools::improperinfo {infotype sel {flag none}} { 11 | 12 | set numimpropers 0 13 | array set impropertypes {} 14 | set atomindex [$sel list] 15 | set improperlist {} 16 | 17 | foreach improper [join [molinfo [$sel molid] get impropers]] { 18 | lassign $improper t a b c d 19 | 20 | if {([lsearch -sorted -integer $atomindex $a] >= 0) \ 21 | && ([lsearch -sorted -integer $atomindex $b] >= 0) \ 22 | && ([lsearch -sorted -integer $atomindex $c] >= 0) \ 23 | && ([lsearch -sorted -integer $atomindex $d] >= 0) } { 24 | set impropertypes($t) 1 25 | incr numimpropers 26 | lappend improperlist $improper 27 | } 28 | } 29 | switch $infotype { 30 | 31 | numimpropers { return $numimpropers } 32 | numimpropertypes { return [array size impropertypes] } 33 | impropertypenames { return [lsort -ascii [array names impropertypes]] } 34 | getimproperlist { return $improperlist } 35 | default { return "bug! shoot the programmer?"} 36 | } 37 | } 38 | 39 | # delete all contained impropers of the selection. 40 | proc ::TopoTools::clearimpropers {sel} { 41 | set mol [$sel molid] 42 | set atomindex [$sel list] 43 | set improperlist {} 44 | 45 | foreach improper [join [molinfo $mol get impropers]] { 46 | lassign $improper t a b c d 47 | 48 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 49 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 50 | || ([lsearch -sorted -integer $atomindex $c] < 0) \ 51 | || ([lsearch -sorted -integer $atomindex $d] < 0) } { 52 | lappend improperlist $improper 53 | } 54 | } 55 | molinfo $mol set impropers [list $improperlist] 56 | } 57 | 58 | # reset impropers to data in improperlist 59 | proc ::TopoTools::setimproperlist {sel improperlist} { 60 | 61 | set mol [$sel molid] 62 | set atomindex [$sel list] 63 | set newimproperlist {} 64 | 65 | # set defaults 66 | set t unknown; set a -1; set b -1; set c -1; set d -1 67 | 68 | # preserve all impropers definitions that are not contained in $sel 69 | foreach improper [join [molinfo $mol get impropers]] { 70 | lassign $improper t a b c d 71 | 72 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 73 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 74 | || ([lsearch -sorted -integer $atomindex $c] < 0) \ 75 | || ([lsearch -sorted -integer $atomindex $d] < 0) } { 76 | lappend newimproperlist $improper 77 | } 78 | } 79 | 80 | # append new ones, but only those contained in $sel 81 | foreach improper $improperlist { 82 | lassign $improper t a b c d 83 | 84 | if {([lsearch -sorted -integer $atomindex $a] >= 0) \ 85 | && ([lsearch -sorted -integer $atomindex $b] >= 0) \ 86 | && ([lsearch -sorted -integer $atomindex $c] >= 0) \ 87 | && ([lsearch -sorted -integer $atomindex $d] >= 0) } { 88 | lappend newimproperlist $improper 89 | } 90 | } 91 | 92 | molinfo $mol set impropers [list $newimproperlist] 93 | } 94 | 95 | # reset impropers to data in improperlist 96 | proc ::TopoTools::retypeimpropers {sel} { 97 | 98 | set mol [$sel molid] 99 | set improperlist [improperinfo getimproperlist $sel] 100 | set atomtypes [$sel get type] 101 | set atomindex [$sel list] 102 | set newimproperlist {} 103 | 104 | foreach improper $improperlist { 105 | lassign $improper type i1 i2 i3 i4 106 | 107 | set idx [lsearch -sorted -integer $atomindex $i1] 108 | set a [lindex $atomtypes $idx] 109 | set idx [lsearch -sorted -integer $atomindex $i2] 110 | set b [lindex $atomtypes $idx] 111 | set idx [lsearch -sorted -integer $atomindex $i3] 112 | set c [lindex $atomtypes $idx] 113 | set idx [lsearch -sorted -integer $atomindex $i4] 114 | set d [lindex $atomtypes $idx] 115 | 116 | if { ([string compare $b $c] > 0) \ 117 | || ( [string equal $b $c] && [string compare $a $d] > 0 ) } { 118 | set t $a; set a $d; set d $t 119 | set t $b; set b $c; set c $t 120 | set t $i1; set i1 $i4; set i4 $t 121 | set t $i2; set i2 $i3; set i3 $t 122 | } 123 | set type [join [list $a $b $c $d] "-"] 124 | 125 | lappend newimproperlist [list $type $i1 $i2 $i3 $i4] 126 | } 127 | setimproperlist $sel $newimproperlist 128 | } 129 | 130 | # reset impropers to definitions derived from bonds. 131 | # this includes retyping of the impropers. 132 | # this step is different from guessing angles or dihedrals, 133 | # as we are only looking for definitions that are unusual. 134 | 135 | proc ::TopoTools::guessimpropers {sel {flags {}}} { 136 | # default tolerance is 5 degrees from planar 137 | set tolerance 5 138 | 139 | # parse optional flags 140 | foreach {key value} $flags { 141 | switch -- $key { 142 | tol - 143 | tolerance {set tolerance $value} 144 | default { 145 | vmdcon -err "guessimpropers: unknown flag: $key" 146 | return -1 147 | } 148 | } 149 | } 150 | 151 | set mol [$sel molid] 152 | set atomtypes [$sel get type] 153 | set atomindex [$sel list] 154 | set newimproperlist {} 155 | 156 | set bonddata [$sel getbonds] 157 | set minangle [expr {180.0 - $tolerance}] 158 | 159 | # preserve all impropers definitions that are not fully contained in $sel 160 | foreach improper [join [molinfo $mol get impropers]] { 161 | lassign $improper t a b c d 162 | 163 | if {([lsearch -sorted -integer $atomindex $a] < 0) \ 164 | || ([lsearch -sorted -integer $atomindex $b] < 0) \ 165 | || ([lsearch -sorted -integer $atomindex $c] < 0) \ 166 | || ([lsearch -sorted -integer $atomindex $d] < 0) } { 167 | lappend newimproperlist $improper 168 | } 169 | } 170 | 171 | # a topological improper is defined by three bonds connected to 172 | # the same atom and their dihedral being almost in plane. 173 | foreach bonds $bonddata aidx $atomindex atyp $atomtypes { 174 | set nbnd [llength $bonds] 175 | if {$nbnd == 3} { 176 | lassign $bonds b1 b2 b3 177 | set ang [expr {abs([measure imprp [list $b1 $b2 $aidx $b3] molid $mol])}] 178 | if {$ang > $minangle} { 179 | set b1idx [lsearch -sorted -integer $atomindex $b1] 180 | set b1typ [lindex $atomtypes $b1idx] 181 | set b2idx [lsearch -sorted -integer $atomindex $b2] 182 | set b2typ [lindex $atomtypes $b2idx] 183 | set b3idx [lsearch -sorted -integer $atomindex $b3] 184 | set b3typ [lindex $atomtypes $b3idx] 185 | 186 | if {([string compare $b1typ $b2typ]) > 0} { 187 | set t1 $b1typ; set b1typ $b2typ; set b2typ $t1 188 | set t2 $b1; set b1 $b2; set b2 $t2 189 | } 190 | if {([string compare $b2typ $b3typ]) > 0} { 191 | set t1 $b2typ; set b2typ $b3typ; set b3typ $t1 192 | set t2 $b2; set b2 $b3; set b3 $t2 193 | } 194 | if {([string compare $b1typ $b2typ]) > 0} { 195 | set t1 $b1typ; set b1typ $b2typ; set b2typ $t1 196 | set t2 $b1; set b1 $b2; set b2 $t2 197 | } 198 | set type [join [list $atyp $b1typ $b2typ $b3typ] "-"] 199 | lappend newimproperlist [list $type $aidx $b1 $b2 $b3] 200 | } 201 | } 202 | } 203 | setimproperlist $sel $newimproperlist 204 | } 205 | 206 | # define a new improper or change an existing one. 207 | proc ::TopoTools::addimproper {mol id1 id2 id3 id4 {type unknown}} { 208 | if {[catch {atomselect $mol "index $id1 $id2 $id3 $id4"} sel]} { 209 | vmdcon -err "topology addimproper: Invalid atom indices: $sel" 210 | return 211 | } 212 | 213 | # canonicalize indices 214 | if {$id2 > $id3} { 215 | set t $id2 ; set id2 $id3 ; set id3 $t 216 | set t $id1 ; set id1 $id4 ; set id4 $t 217 | } 218 | 219 | set impropers [join [molinfo $mol get impropers]] 220 | lappend impropers [list $type $id1 $id2 $id3 $id4] 221 | $sel delete 222 | molinfo $mol set impropers [list $impropers] 223 | } 224 | 225 | # delete a improper. 226 | proc ::TopoTools::delimproper {mol id1 id2 id3 id4 {type unknown}} { 227 | if {[catch {atomselect $mol "index $id1 $id2 $id3 $id4"} sel]} { 228 | vmdcon -err "topology delimproper: Invalid atom indices: $sel" 229 | return 230 | } 231 | 232 | # canonicalize indices 233 | if {$id2 > $id3} { 234 | set t $id2 ; set id2 $id3 ; set id3 $t 235 | set t $id1 ; set id1 $id4 ; set id4 $t 236 | } 237 | 238 | set newimproperlist {} 239 | foreach improper [join [molinfo $mol get impropers]] { 240 | lassign $improper t a b c d 241 | if { ($a != $id1) || ($b != $id2) || ($c != $id3) || ($d != $id4) } { 242 | lappend newimproperlist $improper 243 | } 244 | } 245 | $sel delete 246 | molinfo $mol set impropers [list $newimproperlist] 247 | } 248 | -------------------------------------------------------------------------------- /topotools.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # TopoTools, a VMD package to simplify manipulating bonds 3 | # other topology related properties in VMD. 4 | # 5 | # TODO: 6 | # - topotools.tcl : some operations on bonds can be very slow. 7 | # we may need some optimized variants and/or special 8 | # implementation in VMD for that. 9 | # 10 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020,2022,2023,2024,2025 11 | # by Axel Kohlmeyer 12 | # support for crossterms contributed by Josh Vermaas 13 | # 14 | # $Id: topotools.tcl,v 1.36 2023/04/21 05:41:03 johns Exp $ 15 | 16 | namespace eval ::TopoTools:: { 17 | # for allowing compatibility checks in scripts 18 | # depending on this package. we'll have to expect 19 | variable version 1.10 20 | # location of additional data files containing 21 | # force field parameters or topology data. 22 | variable datadir $env(TOPOTOOLSDIR) 23 | # print a citation reminder, but only once. 24 | variable topociteme 1 25 | # same for topogromacs 26 | variable gmxciteme 1 27 | # flag to print warning about atomselect 28 | variable masswarn 1 29 | # if nonzero, add a new representation with default settings, 30 | # when creating a new molecule. similar to what "mol new" does. 31 | variable newaddsrep 1 32 | 33 | # per package global constants: 34 | # conversion factor for kJ from kcal 35 | variable kjinkcal 4.184 36 | 37 | # element names from PTE 38 | variable elements {X H He Li Be B C N O F Ne Na Mg Al Si P 39 | S Cl Ar K Ca Sc Ti V Cr Mn Fe Co Ni Cu Zn Ga Ge As 40 | Se Br Kr Rb Sr Y Zr Nb Mo Tc Ru Rh Pd Ag Cd In Sn 41 | Sb Te I Xe Cs Ba La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho 42 | Er Tm Yb Lu Hf Ta W Re Os Ir Pt Au Hg Tl Pb Bi Po 43 | At Rn Fr Ra Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md 44 | No Lr Rf Db Sg Bh Hs Mt Ds Rg} 45 | 46 | # element masses in AMU 47 | variable masses {0.00000 1.00794 4.00260 6.941 9.012182 10.811 48 | 12.0107 14.0067 15.9994 18.9984032 20.1797 22.989770 49 | 24.3050 26.981538 28.0855 30.973761 32.065 35.453 50 | 39.948 39.0983 40.078 44.955910 47.867 50.9415 51 | 51.9961 54.938049 55.845 58.9332 58.6934 63.546 52 | 65.409 69.723 72.64 74.92160 78.96 79.904 83.798 53 | 85.4678 87.62 88.90585 91.224 92.90638 95.94 98.0 54 | 101.07 102.90550 106.42 107.8682 112.411 114.818 55 | 118.710 121.760 127.60 126.90447 131.293 132.90545 56 | 137.327 138.9055 140.116 140.90765 144.24 145.0 57 | 150.36 151.964 157.25 158.92534 162.500 164.93032 58 | 167.259 168.93421 173.04 174.967 178.49 180.9479 59 | 183.84 186.207 190.23 192.217 195.078 196.96655 60 | 200.59 204.3833 207.2 208.98038 209.0 210.0 222.0 61 | 223.0 226.0 227.0 232.0381 231.03588 238.02891 62 | 237.0 244.0 243.0 247.0 247.0 251.0 252.0 257.0 63 | 258.0 259.0 262.0 261.0 262.0 266.0 264.0 269.0 64 | 268.0 271.0 272.0} 65 | 66 | # VdW radii, ionic radii for elements that are commonly 67 | # ionic in typical systems. unknown elements set to 2.0. 68 | variable radii {1.5 1.2 1.4 1.82 2.0 2.0 1.7 1.55 1.52 69 | 1.47 1.54 1.36 1.18 2.0 2.1 1.8 1.8 2.27 1.88 1.76 70 | 1.37 2.0 2.0 2.0 2.0 2.0 2.0 2.0 1.63 1.4 1.39 1.07 71 | 2.0 1.85 1.9 1.85 2.02 2.0 2.0 2.0 2.0 2.0 2.0 2.0 72 | 2.0 2.0 1.63 1.72 1.58 1.93 2.17 2.0 2.06 1.98 2.16 73 | 2.1 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 74 | 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 1.72 1.66 75 | 1.55 1.96 2.02 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 76 | 1.86 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 77 | 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0} 78 | 79 | # utility command exports. the other commands are 80 | # best used through the "topo" frontend command. 81 | # part 1: operations on whole systems/selections 82 | namespace export mergemols selections2mol replicatemol 83 | } 84 | 85 | # help/usage/error message and online documentation. 86 | proc ::TopoTools::usage {} { 87 | vmdcon -info "usage: topo \[args...\] " 88 | vmdcon -info "" 89 | vmdcon -info "common flags:" 90 | vmdcon -info " -molid |top molecule id (default: 'top')" 91 | vmdcon -info " -sel atom selection function or text (default: 'all')" 92 | # vmdcon -info " -relindex 0|1 indices in arguments are interpreted as absolute" 93 | # vmdcon -info " or relative. (default: '0')" 94 | vmdcon -info "flags only applicable to 'bond' commands:" 95 | vmdcon -info " -bondtype bond type name (default: unknown)" 96 | vmdcon -info " -bondorder bond order parameter (default: 1)" 97 | vmdcon -info "" 98 | vmdcon -info "commands:" 99 | vmdcon -info " help prints this message" 100 | vmdcon -info "" 101 | vmdcon -info " numatoms returns the number of unique atoms." 102 | vmdcon -info " numatomtypes returns the number of atom types." 103 | vmdcon -info " atomtypenames returns the list of atom types names." 104 | vmdcon -info "" 105 | vmdcon -info " guessatom (re-)set atom data heuristically. currently supported:" 106 | vmdcon -info " element from mass, element from name, element from type, mass from element," 107 | vmdcon -info " name from element, name from type, radius from element, type from element," 108 | vmdcon -info " type from name, lammps from data (= element<-mass, name & radius<-element)" 109 | vmdcon -info "" 110 | vmdcon -info " numbonds returns the number of unique bonds." 111 | vmdcon -info " numbondtypes returns the number of bond types." 112 | vmdcon -info " bondtypenames returns the list of bond types names." 113 | vmdcon -info " clearbonds deletes all bonds. " 114 | vmdcon -info " retypebonds resets all bond types. " 115 | vmdcon -info " guessbonds guesses bonds from atom radii (currently only works for selection 'all')." 116 | vmdcon -info "" 117 | vmdcon -info " addbond (re-)defines a single bond." 118 | vmdcon -info " delbond deletes a single bond, if it exists." 119 | vmdcon -info "" 120 | vmdcon -info " getbondlist \[type|order|both|none\]" 121 | vmdcon -info " returns a list of unique bonds, optionally" 122 | vmdcon -info " including bond order and bond type." 123 | vmdcon -info " setbondlist \[type|order|both|none\] " 124 | vmdcon -info " resets all bonds from a list in the same" 125 | vmdcon -info " format as returned by 'topo getbondlist'." 126 | vmdcon -info " order or type are reset to defaults if not given." 127 | vmdcon -info "" 128 | vmdcon -info " num(angle|dihedral|improper)s returns the number of unique (angle|dihedral|improper)s" 129 | vmdcon -info " num(angle|dihedral|improper)types returns the number of (angle|dihedral|improper) types" 130 | vmdcon -info " (angle|dihedral|improper)typenames returns the list of bond type names" 131 | vmdcon -info " clear(angle|dihedral|improper)s deletes all (angle|dihedral|improper)s. " 132 | vmdcon -info " sort(angle|dihedral|improper)s sorts the list of (angle|dihedral|improper)s" 133 | vmdcon -info " according to atom index and removes duplicates" 134 | vmdcon -info " retype(angle|dihedral|improper)s resets all angle types. " 135 | vmdcon -info "" 136 | vmdcon -info " guess(angle|dihedral)s guesses angle and dihedral definitions from bonds." 137 | vmdcon -info " guessimproper \[tolerance \] guesses improper definitions from bonds. impropers are only defined" 138 | vmdcon -info " for atoms bonded to three other atoms with a near flat structure." 139 | vmdcon -info " the tolerance flag changes the allowed deviation from 180 deg (default: 5 deg)." 140 | vmdcon -info "" 141 | vmdcon -info " addangle \[\] (re-defines) a single angle." 142 | vmdcon -info " delangle (re-defines) a single angle." 143 | vmdcon -info " add(dihedral|improper) \[\] (re-)defines a single (dihedral|improper)." 144 | vmdcon -info " del(dihedral|improper) deletes a single (dihedral|improper)." 145 | vmdcon -info "" 146 | vmdcon -info "" 147 | vmdcon -info " getanglelist returns the list of angle definitions" 148 | vmdcon -info " in the form {type }" 149 | vmdcon -info " setanglelist " 150 | vmdcon -info " resets angle definitions from a list in the same" 151 | vmdcon -info " format as retured by 'topo getanglelist'" 152 | vmdcon -info " get(dihedral|improper)list returns the list of (dihedral|improper) definitions" 153 | vmdcon -info " in the form {type }" 154 | vmdcon -info " set(dihedral|improper)list " 155 | vmdcon -info " resets (dihedral|improper) definitions from a list in the same" 156 | vmdcon -info " format as retured by 'topo get(dihedral|improper)list'" 157 | vmdcon -info "NOTE: for angle, dihedral, and improper lists, the" 158 | vmdcon -info " type field currently has to be always present." 159 | vmdcon -info "" 160 | vmdcon -info " numcrossterms returns the number of crossterms." 161 | vmdcon -info " clearcrossterms deletes all crossterms. " 162 | vmdcon -info " addcrossterm (re-)defines a single crossterm." 163 | vmdcon -info " delcrossterm deletes a single crossterm." 164 | vmdcon -info " getcrosstermlist returns the list of crossterm definitions" 165 | vmdcon -info " in the form { }" 166 | vmdcon -info " setcrosstermlist " 167 | vmdcon -info " resets crossterm definitions from a list in the same" 168 | vmdcon -info " format as retured by 'topo getcrosstermlist'" 169 | vmdcon -info "" 170 | vmdcon -info "" 171 | vmdcon -info " readlammpsdata \[\]" 172 | vmdcon -info " read atom coordinates, properties, bond, angle, dihedral and other related data" 173 | vmdcon -info " from a LAMMPS data file. 'atomstyle' is the value given to the 'atom_style'" 174 | vmdcon -info " parameter. Default is to autodetect from embedded hints with fallback to 'full'." 175 | vmdcon -info " this subcommand creates a new molecule and returns the molecule id or -1 on failure." 176 | vmdcon -info " the -sel parameter is currently ignored." 177 | vmdcon -info "" 178 | vmdcon -info " writelammpsdata \[typelabels\] \[\]" 179 | vmdcon -info " write atom properties, bond, angle, dihedral and other related data" 180 | vmdcon -info " to a LAMMPS data file. If the \"typelabels\" keyword is present, use symbolic" 181 | vmdcon -info " types and write '* Type Labels' sections, otherwise traditional numeric types" 182 | vmdcon -info " will be used. The final option 'atomstyle' determines the format of the 'Atoms'" 183 | vmdcon -info " section is the value given to the 'atom_style' LAMMPS keyword. Default value is 'full'." 184 | vmdcon -info " Only data that is present is written. " 185 | vmdcon -info "" 186 | vmdcon -info " readvarxyz " 187 | vmdcon -info " read an xmol/xyz format trajectory with a varying numer of particles." 188 | vmdcon -info " This is normally not supported by VMD and the script circumvents this" 189 | vmdcon -info " restriction by automatically adding dummy particles and then indicating" 190 | vmdcon -info " the presence of a given atom in a given frame by setting its user field" 191 | vmdcon -info " to either 1.0 or -1.0 in case of an atom being present or not, respectively." 192 | vmdcon -info " For efficiency reasons, atoms are sorted by atom type, so atom order and bonding" 193 | vmdcon -info " are not preserved. The function returns the new molecule id or -1." 194 | vmdcon -info "" 195 | vmdcon -info " writevarxyz \[selmod \] \[first|last|step \]" 196 | vmdcon -info " write an xmol/xyz format trajectory files with a varying number of particles." 197 | vmdcon -info " This is the counter part to the 'readvarxyz' subcommand." 198 | vmdcon -info " The optional selection string in the argument indicates" 199 | vmdcon -info " how to select the atoms. Its default is 'user > 0'." 200 | vmdcon -info "" 201 | vmdcon -info " writegmxtop \[ \[\]...\]" 202 | vmdcon -info " write a Gromacs topology format file." 203 | vmdcon -info " Without a CHARMM parameter file, the resulting file uses bogus force field" 204 | vmdcon -info " parameters to be just sufficient so the generated file can be used in combination" 205 | vmdcon -info " with a .gro/.pdb coordinate file for generating .tpr files needed to use" 206 | vmdcon -info " some of the more advanced gromacs analysis tools for simulation data that" 207 | vmdcon -info " was not generated with Gromacs." 208 | vmdcon -info " When using one or more CHARMM parameter files as arguments, the generated file" 209 | vmdcon -info " will be sufficient to run simulations with Gromacs. For that to work, the topology" 210 | vmdcon -info " must be read from an X-plor style PSF file with symbolic (not numeric) atom types.\n" 211 | citation_reminder 212 | return 213 | } 214 | 215 | # the main frontend command. 216 | # this takes care of all sanity checks on arguments and 217 | # then dispatches the subcommands to the corresponding 218 | # subroutines. 219 | proc ::TopoTools::topo { args } { 220 | variable version 221 | 222 | set molid -1 223 | set seltxt all 224 | set localsel 1 225 | set selmol -1 226 | set bondtype unknown 227 | set bondorder 1.0 228 | 229 | set cmd {} 230 | set sel {} ; # need to initialize it here for scoping 231 | 232 | # process generic arguments and remove them 233 | # from argument list. 234 | set newargs {} 235 | for {set i 0} {$i < [llength $args]} {incr i} { 236 | set arg [lindex $args $i] 237 | 238 | if {[string match -?* $arg]} { 239 | 240 | set val [lindex $args [expr $i+1]] 241 | 242 | switch -- $arg { 243 | -molid { 244 | if {[catch {molinfo $val get name} res]} { 245 | vmdcon -err "Invalid -molid argument '$val': $res" 246 | citation_reminder 247 | return 248 | } 249 | set molid $val 250 | if {[string equal $molid "top"]} { 251 | set molid [molinfo top] 252 | } 253 | incr i 254 | } 255 | 256 | -sel { 257 | # check if the argument to -sel is a valid atomselect command 258 | if {([info commands $val] != "") && ([string equal -length 10 $val atomselect])} { 259 | set localsel 0 260 | set selmol [$val molid] 261 | set sel $val 262 | } else { 263 | set localsel 1 264 | set seltxt $val 265 | } 266 | incr i 267 | } 268 | 269 | -bondtype { 270 | if {[string length $val] < 1} { 271 | vmdcon -err "Invalid -bondtype argument '$val'" 272 | citation_reminder 273 | return 274 | } 275 | set bondtype $val 276 | incr i 277 | } 278 | 279 | -bondorder { 280 | if {[string length $val] < 1} { 281 | vmdcon -err "Invalid -bondorder argument '$val'" 282 | citation_reminder 283 | return 284 | } 285 | set bondorder $val 286 | incr i 287 | } 288 | 289 | -- break 290 | 291 | default { 292 | vmdcon -info "default: $arg" 293 | } 294 | } 295 | } else { 296 | lappend newargs $arg 297 | } 298 | } 299 | 300 | if {$molid < 0} { 301 | set molid $selmol 302 | } 303 | if {$molid < 0} { 304 | set molid [molinfo top] 305 | } 306 | 307 | set retval "" 308 | if {[llength $newargs] > 0} { 309 | set cmd [lindex $newargs 0] 310 | set newargs [lrange $newargs 1 end] 311 | } else { 312 | set newargs {} 313 | set cmd help 314 | } 315 | 316 | # check whether we have a valid command. 317 | set validcmd {readvarxyz writevarxyz readlammpsdata writelammpsdata 318 | writegmxtop help numatoms numatomtypes atomtypenames guessatom 319 | getbondlist bondtypenames numbondtypes numbonds setbondlist 320 | retypebonds clearbonds guessbonds addbond delbond getanglelist 321 | angletypenames numangletypes numangles setanglelist retypeangles 322 | clearangles guessangles addangle delangle sortangles getdihedrallist 323 | dihedraltypenames numdihedraltypes numdihedrals setdihedrallist 324 | retypedihedrals cleardihedrals guessdihedrals adddihedral 325 | deldihedral sortdihedrals getimproperlist impropertypenames 326 | numimpropertypes numimpropers setimproperlist retypeimpropers 327 | clearimpropers guessimpropers addimproper delimproper sortimpropers 328 | getcrosstermlist numcrossterms setcrosstermlist clearcrossterms 329 | addcrossterm delcrossterm} 330 | if {[lsearch -exact $validcmd $cmd] < 0} { 331 | vmdcon -err "Unknown topotools command '$cmd'" 332 | usage 333 | return 334 | } 335 | 336 | # we need a few special cases for reading coordinate/topology files. 337 | if {[string equal $cmd readlammpsdata]} { 338 | set style auto 339 | if {[llength $newargs] < 1} { 340 | vmdcon -err "Not enough arguments for 'topo readlammpsdata'" 341 | usage 342 | return 343 | } 344 | set fname [lindex $newargs 0] 345 | if {[llength $newargs] > 1} { 346 | set style [lindex $newargs 1] 347 | } 348 | if {[checklammpsstyle $style]} { 349 | vmdcon -err "Atom style '$style' is not supported by TopoTools $version" 350 | citation_reminder 351 | return 352 | } 353 | set retval [readlammpsdata $fname $style] 354 | citation_reminder 355 | return $retval 356 | } 357 | 358 | if {[string equal $cmd readvarxyz]} { 359 | set fname [lindex $newargs 0] 360 | set retval [readvarxyz $fname] 361 | citation_reminder 362 | return $retval 363 | } 364 | 365 | if { ![string equal $cmd help] } { 366 | if {($selmol >= 0) && ($selmol != $molid)} { 367 | vmdcon -err "Molid from selection '$selmol' does not match -molid argument '$molid'" 368 | citation_reminder 369 | return 370 | } 371 | if {$molid < 0} { 372 | vmdcon -err "Cannot use 'topo $cmd' without a molecule" 373 | citation_reminder 374 | return 375 | } 376 | 377 | if {$localsel} { 378 | # need to create a selection 379 | if {[catch {atomselect $molid $seltxt} sel]} { 380 | vmdcon -err "Problem with atom selection using '$seltxt': $sel" 381 | citation_reminder 382 | return 383 | } 384 | } 385 | } 386 | 387 | # branch out to the various subcommands 388 | switch -- $cmd { 389 | numatoms - 390 | numatomtypes - 391 | atomtypenames { 392 | if {[llength $newargs] < 1} {set newargs none} 393 | set retval [atominfo $cmd $sel $newargs] 394 | } 395 | 396 | guessatom { 397 | if {[llength $newargs] < 2} { 398 | vmdcon -err "'topo guessatom' requires two arguments: " 399 | usage 400 | return 401 | } 402 | set retval [guessatomdata $sel [lindex $newargs 0] [lindex $newargs 1]] 403 | } 404 | 405 | getbondlist - 406 | bondtypenames - 407 | numbondtypes - 408 | numbonds { 409 | if {[llength $newargs] < 1} {set newargs none} 410 | set retval [bondinfo $cmd $sel $newargs] 411 | } 412 | 413 | setbondlist { 414 | set flag none 415 | if {[llength $newargs] > 1} { 416 | set flag [lindex $newargs 0] 417 | set newargs [lrange $newargs 1 end] 418 | } 419 | if {[llength $newargs] < 1} {set newargs none} 420 | set retval [setbondlist $sel $flag [lindex $newargs 0]] 421 | } 422 | 423 | retypebonds { 424 | set retval [retypebonds $sel] 425 | } 426 | 427 | clearbonds { 428 | set retval [clearbonds $sel] 429 | } 430 | 431 | guessbonds { 432 | set retval [guessbonds $sel] 433 | } 434 | 435 | addbond { 436 | if {[llength $newargs] < 2} { 437 | vmdcon -err "Not enough arguments for 'topo addbond'" 438 | usage 439 | return 440 | } 441 | set retval [addbond $molid \ 442 | [lindex $newargs 0] \ 443 | [lindex $newargs 1] \ 444 | $bondtype $bondorder] 445 | } 446 | 447 | delbond { 448 | if {[llength $newargs] < 2} { 449 | vmdcon -err "Not enough arguments for 'topo addbond'" 450 | usage 451 | return 452 | } 453 | set retval [delbond $molid \ 454 | [lindex $newargs 0] \ 455 | [lindex $newargs 1] \ 456 | $bondtype $bondorder] 457 | } 458 | 459 | getanglelist - 460 | angletypenames - 461 | numangletypes - 462 | numangles { 463 | if {[llength $newargs] < 1} {set newargs none} 464 | set retval [angleinfo $cmd $sel $newargs] 465 | } 466 | 467 | setanglelist { 468 | set retval [setanglelist $sel [lindex $newargs 0]] 469 | } 470 | 471 | retypeangles { 472 | set retval [retypeangles $sel] 473 | } 474 | 475 | guessangles { 476 | set retval [guessangles $sel] 477 | } 478 | 479 | sortangles { 480 | set retval [sortsomething angle $sel] 481 | } 482 | 483 | clearangles { 484 | set retval [clearangles $sel] 485 | } 486 | 487 | addangle { 488 | set atype unknown 489 | if {[llength $newargs] < 3} { 490 | vmdcon -err "Not enough arguments for 'topo addangle'" 491 | usage 492 | return 493 | } 494 | if {[llength $newargs] > 3} { 495 | set atype [lindex $newargs 3] 496 | } 497 | set retval [addangle $molid \ 498 | [lindex $newargs 0] \ 499 | [lindex $newargs 1] \ 500 | [lindex $newargs 2] \ 501 | $atype] 502 | } 503 | 504 | delangle { 505 | set atype unknown 506 | if {[llength $newargs] < 3} { 507 | vmdcon -err "Not enough arguments for 'topo delangle'" 508 | usage 509 | return 510 | } 511 | set retval [delangle $molid \ 512 | [lindex $newargs 0] \ 513 | [lindex $newargs 1] \ 514 | [lindex $newargs 2] ] 515 | } 516 | 517 | getdihedrallist - 518 | dihedraltypenames - 519 | numdihedraltypes - 520 | numdihedrals { 521 | if {[llength $newargs] < 1} {set newargs none} 522 | set retval [dihedralinfo $cmd $sel $newargs] 523 | } 524 | 525 | setdihedrallist { 526 | set retval [setdihedrallist $sel [lindex $newargs 0]] 527 | } 528 | 529 | retypedihedrals { 530 | set retval [retypedihedrals $sel] 531 | } 532 | 533 | guessdihedrals { 534 | set retval [guessdihedrals $sel] 535 | } 536 | 537 | sortdihedrals { 538 | set retval [sortsomething dihedral $sel] 539 | } 540 | 541 | cleardihedrals { 542 | set retval [cleardihedrals $sel] 543 | } 544 | 545 | adddihedral { 546 | set atype unknown 547 | if {[llength $newargs] < 4} { 548 | vmdcon -err "Not enough arguments for 'topo adddihedral'" 549 | usage 550 | return 551 | } 552 | if {[llength $newargs] > 4} { 553 | set atype [lindex $newargs 4] 554 | } 555 | set retval [adddihedral $molid \ 556 | [lindex $newargs 0] \ 557 | [lindex $newargs 1] \ 558 | [lindex $newargs 2] \ 559 | [lindex $newargs 3] \ 560 | $atype] 561 | } 562 | 563 | deldihedral { 564 | set atype unknown 565 | if {[llength $newargs] < 4} { 566 | vmdcon -err "Not enough arguments for 'topo deldihedral'" 567 | usage 568 | return 569 | } 570 | set retval [deldihedral $molid \ 571 | [lindex $newargs 0] \ 572 | [lindex $newargs 1] \ 573 | [lindex $newargs 2] \ 574 | [lindex $newargs 3] ] 575 | } 576 | 577 | getimproperlist - 578 | impropertypenames - 579 | numimpropertypes - 580 | numimpropers { 581 | if {[llength $newargs] < 1} {set newargs none} 582 | set retval [improperinfo $cmd $sel $newargs] 583 | } 584 | 585 | setimproperlist { 586 | set retval [setimproperlist $sel [lindex $newargs 0]] 587 | } 588 | 589 | retypeimpropers { 590 | set retval [retypeimpropers $sel] 591 | } 592 | 593 | guessimpropers { 594 | set retval [guessimpropers $sel $newargs] 595 | } 596 | 597 | sortimpropers { 598 | set retval [sortsomething improper $sel] 599 | } 600 | 601 | clearimpropers { 602 | set retval [clearimpropers $sel] 603 | } 604 | 605 | addimproper { 606 | set atype unknown 607 | if {[llength $newargs] < 4} { 608 | vmdcon -err "Not enough arguments for 'topo addimproper'" 609 | usage 610 | return 611 | } 612 | if {[llength $newargs] > 4} { 613 | set atype [lindex $newargs 4] 614 | } 615 | set retval [addimproper $molid \ 616 | [lindex $newargs 0] \ 617 | [lindex $newargs 1] \ 618 | [lindex $newargs 2] \ 619 | [lindex $newargs 3] \ 620 | $atype] 621 | } 622 | 623 | delimproper { 624 | set atype unknown 625 | if {[llength $newargs] < 4} { 626 | vmdcon -err "Not enough arguments for 'topo delimproper'" 627 | usage 628 | return 629 | } 630 | set retval [delimproper $molid \ 631 | [lindex $newargs 0] \ 632 | [lindex $newargs 1] \ 633 | [lindex $newargs 2] \ 634 | [lindex $newargs 3] ] 635 | } 636 | 637 | getcrosstermlist - 638 | numcrossterms { 639 | if {[llength $newargs] < 1} {set newargs none} 640 | set retval [crossterminfo $cmd $sel $newargs] 641 | } 642 | 643 | setcrosstermlist { 644 | set retval [setcrosstermlist $sel [lindex $newargs 0]] 645 | } 646 | 647 | clearcrossterms { 648 | set retval [clearcrossterms $sel] 649 | } 650 | 651 | addcrossterm { 652 | if {[llength $newargs] < 8} { 653 | vmdcon -err "Not enough arguments for 'topo addcrossterm'" 654 | usage 655 | return 656 | } 657 | set retval [addcrossterm $molid \ 658 | [lindex $newargs 0] \ 659 | [lindex $newargs 1] \ 660 | [lindex $newargs 2] \ 661 | [lindex $newargs 3] \ 662 | [lindex $newargs 4] \ 663 | [lindex $newargs 5] \ 664 | [lindex $newargs 6] \ 665 | [lindex $newargs 7] ] 666 | } 667 | 668 | delcrossterm { 669 | set atype unknown 670 | if {[llength $newargs] < 8} { 671 | vmdcon -err "Not enough arguments for 'topo delcrossterm'" 672 | usage 673 | return 674 | } 675 | set retval [delcrossterm $molid \ 676 | [lindex $newargs 0] \ 677 | [lindex $newargs 1] \ 678 | [lindex $newargs 2] \ 679 | [lindex $newargs 3] \ 680 | [lindex $newargs 4] \ 681 | [lindex $newargs 5] \ 682 | [lindex $newargs 6] \ 683 | [lindex $newargs 7] ] 684 | } 685 | 686 | 687 | writelammpsdata { ;# NOTE: readlammpsdata is handled above to bypass check for sel/molid. 688 | set style full 689 | if {[llength $newargs] < 1} { 690 | vmdcon -err "Not enough arguments for 'topo writelammpsdata'" 691 | usage 692 | return 693 | } 694 | set typelabels 0 695 | set fname [lindex $newargs 0] 696 | if {[llength $newargs] > 1} { 697 | if {[lindex $newargs 1] == "typelabels"} { 698 | set typelabels 1 699 | if {[llength $newargs] > 2} { 700 | set style [lindex $newargs 2] 701 | } 702 | } else { 703 | set style [lindex $newargs 1] 704 | } 705 | } 706 | if {[checklammpsstyle $style]} { 707 | vmdcon -err "Atom style '$style' not supported." 708 | usage 709 | return 710 | } 711 | set retval [writelammpsdata $molid $fname $typelabels $style $sel] 712 | } 713 | 714 | writevarxyz { ;# NOTE: readvarxyz is handled above to bypass check for sel/molid. 715 | if {[llength $newargs] < 1} { 716 | vmdcon -err "Not enough arguments for 'topo writevarxyz'" 717 | usage 718 | return 719 | } 720 | set fname [lindex $newargs 0] 721 | set retval [writevarxyz $fname $molid $sel [lrange $newargs 1 end]] 722 | } 723 | 724 | writegmxtop { ;# NOTE: readgmxtop is handled above to bypass check for sel/molid. 725 | if {[llength $newargs] < 1} { 726 | vmdcon -err "Not enough arguments for 'topo writegmxtop'" 727 | usage 728 | return 729 | } 730 | set fname [lindex $newargs 0] 731 | set retval [writegmxtop $fname $molid $sel [lrange $newargs 1 end]] 732 | } 733 | 734 | help - 735 | default { 736 | usage 737 | } 738 | } 739 | if {$localsel && ($sel != "")} { 740 | $sel delete 741 | } 742 | citation_reminder 743 | return $retval 744 | } 745 | 746 | # gently remind people that the should cite the cg papers. 747 | proc ::TopoTools::citation_reminder {args} { 748 | variable topociteme 749 | variable version 750 | 751 | if {$topociteme} { 752 | vmdcon -info "======================" 753 | vmdcon -info "Please cite TopoTools as:" 754 | vmdcon -info "Axel Kohlmeyer & Josh Vermaas, (2025). TopoTools: Release $version" 755 | vmdcon -info "https://doi.org/10.5281/zenodo.598373" 756 | vmdcon -info "======================\n" 757 | set topociteme 0 758 | } 759 | return 760 | } 761 | 762 | # load middleware API 763 | source [file join $env(TOPOTOOLSDIR) topoatoms.tcl] 764 | source [file join $env(TOPOTOOLSDIR) topobonds.tcl] 765 | source [file join $env(TOPOTOOLSDIR) topoangles.tcl] 766 | source [file join $env(TOPOTOOLSDIR) topodihedrals.tcl] 767 | source [file join $env(TOPOTOOLSDIR) topoimpropers.tcl] 768 | source [file join $env(TOPOTOOLSDIR) topocrossterms.tcl] 769 | 770 | # load high-level API 771 | source [file join $env(TOPOTOOLSDIR) topolammps.tcl] 772 | source [file join $env(TOPOTOOLSDIR) topogromacs.tcl] 773 | source [file join $env(TOPOTOOLSDIR) topovarxyz.tcl] 774 | 775 | # load high-level utility functions 776 | source [file join $env(TOPOTOOLSDIR) topoutils.tcl] 777 | 778 | # load internal helper functions 779 | source [file join $env(TOPOTOOLSDIR) topohelpers.tcl] 780 | 781 | # insert the "topo" frontend command into the normal namespace 782 | interp alias {} topo {} ::TopoTools::topo 783 | 784 | package provide topotools $::TopoTools::version 785 | 786 | -------------------------------------------------------------------------------- /topoutils.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # TopoTools, a VMD package to simplify manipulating bonds 3 | # other topology related properties in VMD. 4 | # 5 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer 6 | # support for crossterms contributed by Josh Vermaas 7 | # 8 | # $Id: topoutils.tcl,v 1.20 2020/07/01 05:19:33 johns Exp $ 9 | 10 | # utility commands 11 | 12 | # merge molecules from a list of molecule ids 13 | # to form one new "molecule", i.e. system. 14 | proc ::TopoTools::mergemols {mids} { 15 | 16 | # compute total number of atoms and collect 17 | # offsets and number of atoms of each piece. 18 | set ntotal 0 19 | set offset {} 20 | set numlist {} 21 | foreach m $mids { 22 | if {[catch {molinfo $m get numatoms} natoms]} { 23 | vmdcon -err "molecule id $m does not exist." 24 | return -1 25 | } else { 26 | # record number of atoms and offsets for later use. 27 | lappend offset $ntotal 28 | lappend numlist $natoms 29 | incr ntotal $natoms 30 | } 31 | } 32 | 33 | if {!$ntotal} { 34 | vmdcon -err "mergemols: combined molecule has no atoms." 35 | return -1 36 | } 37 | 38 | # create new molecule to hold data. 39 | set mol -1 40 | if {[catch {mol new atoms $ntotal} mol]} { 41 | vmdcon -err "mergemols: could not create new molecule: $mol" 42 | return -1 43 | } else { 44 | animate dup $mol 45 | } 46 | mol rename $mol [string range mergedmol-[join $mids -] 0 50] 47 | 48 | # copy data over piece by piece 49 | set bondlist {} 50 | set anglelist {} 51 | set dihedrallist {} 52 | set improperlist {} 53 | set ctermlist {} 54 | foreach m $mids off $offset num $numlist { 55 | set oldsel [atomselect $m all] 56 | set newsel [atomselect $mol "index $off to [expr {$off+$num-1}]"] 57 | 58 | # per atom props 59 | set cpylist {name type mass charge radius element x y z \ 60 | resname resid chain segname} 61 | $newsel set $cpylist [$oldsel get $cpylist] 62 | 63 | # assign structure data. we need to renumber indices 64 | set list [topo getbondlist both -molid $m] 65 | foreach l $list { 66 | lassign $l a b t o 67 | lappend bondlist [list [expr {$a+$off}] [expr {$b+$off}] $t $o] 68 | } 69 | 70 | set list [topo getanglelist -molid $m] 71 | foreach l $list { 72 | lassign $l t a b c 73 | lappend anglelist [list $t [expr {$a+$off}] [expr {$b+$off}] [expr {$c+$off}]] 74 | } 75 | 76 | set list [topo getdihedrallist -molid $m] 77 | foreach l $list { 78 | lassign $l t a b c d 79 | lappend dihedrallist [list $t [expr {$a+$off}] [expr {$b+$off}] \ 80 | [expr {$c+$off}] [expr {$d+$off}]] 81 | } 82 | set list [topo getimproperlist -molid $m] 83 | foreach l $list { 84 | lassign $l t a b c d 85 | lappend improperlist [list $t [expr {$a + $off}] [expr {$b + $off}] \ 86 | [expr {$c + $off}] [expr {$d + $off}]] 87 | } 88 | set list [topo getcrosstermlist -molid $m] 89 | foreach l $list { 90 | lassign $l a b c d e f g h 91 | lappend ctermlist [list [expr {$a + $off}] [expr {$b + $off}] \ 92 | [expr {$c + $off}] [expr {$d + $off}] \ 93 | [expr {$e + $off}] [expr {$f + $off}] \ 94 | [expr {$g + $off}] [expr {$h + $off}]] 95 | } 96 | $oldsel delete 97 | $newsel delete 98 | } 99 | 100 | # apply structure info 101 | topo setbondlist both -molid $mol $bondlist 102 | topo setanglelist -molid $mol $anglelist 103 | topo setdihedrallist -molid $mol $dihedrallist 104 | topo setimproperlist -molid $mol $improperlist 105 | topo setcrosstermlist -molid $mol $ctermlist 106 | # set box to be largest of the available boxes 107 | set amax 0.0 108 | set bmax 0.0 109 | set cmax 0.0 110 | foreach m $mids { 111 | lassign [molinfo $m get {a b c}] a b c 112 | if {$a > $amax} {set amax $a} 113 | if {$b > $bmax} {set bmax $b} 114 | if {$c > $cmax} {set cmax $c} 115 | } 116 | molinfo $mol set {a b c} [list $amax $bmax $cmax] 117 | 118 | variable newaddsrep 119 | mol reanalyze $mol 120 | if {$newaddsrep} { 121 | adddefaultrep $mol 122 | } 123 | return $mol 124 | } 125 | 126 | # build a new molecule from one or more selections 127 | proc ::TopoTools::selections2mol {sellist} { 128 | 129 | # compute total number of atoms and collect 130 | # offsets and number of atoms of each piece. 131 | set ntotal 0 132 | set offset {} 133 | set numlist {} 134 | foreach s $sellist { 135 | if {[catch {$s num} natoms]} { 136 | vmdcon -err "selection access error: $natoms" 137 | return -1 138 | } else { 139 | # record number of atoms and offsets for later use. 140 | lappend offset $ntotal 141 | lappend numlist $natoms 142 | incr ntotal $natoms 143 | } 144 | } 145 | 146 | if {!$ntotal} { 147 | vmdcon -err "selections2mol: combined molecule has no atoms." 148 | return -1 149 | } 150 | 151 | # create new molecule to hold data. 152 | set mol -1 153 | if {[catch {mol new atoms $ntotal} mol]} { 154 | vmdcon -err "selection2mol: could not create new molecule: $mol" 155 | return -1 156 | } else { 157 | animate dup $mol 158 | } 159 | mol rename $mol selections2mol-[molinfo num] 160 | 161 | # copy data over piece by piece 162 | set bondlist {} 163 | set anglelist {} 164 | set dihedrallist {} 165 | set improperlist {} 166 | set ctermlist {} 167 | foreach sel $sellist off $offset num $numlist { 168 | set newsel [atomselect $mol "index $off to [expr {$off+$num-1}]"] 169 | 170 | # per atom props 171 | set cpylist {name type mass charge radius element x y z \ 172 | resname resid chain segname} 173 | $newsel set $cpylist [$sel get $cpylist] 174 | 175 | # get atom index map for this selection 176 | set atomidmap [$sel get index] 177 | 178 | # assign structure data. we need to renumber indices 179 | set list [topo getbondlist both -sel $sel] 180 | foreach l $list { 181 | lassign $l a b t o 182 | set anew [expr [lsearch -sorted -integer $atomidmap $a] + $off] 183 | set bnew [expr [lsearch -sorted -integer $atomidmap $b] + $off] 184 | lappend bondlist [list $anew $bnew $t $o] 185 | } 186 | 187 | set list [topo getanglelist -sel $sel] 188 | foreach l $list { 189 | lassign $l t a b c 190 | set anew [expr [lsearch -sorted -integer $atomidmap $a] + $off] 191 | set bnew [expr [lsearch -sorted -integer $atomidmap $b] + $off] 192 | set cnew [expr [lsearch -sorted -integer $atomidmap $c] + $off] 193 | lappend anglelist [list $t $anew $bnew $cnew] 194 | } 195 | 196 | set list [topo getdihedrallist -sel $sel] 197 | foreach l $list { 198 | lassign $l t a b c d 199 | set anew [expr [lsearch -sorted -integer $atomidmap $a] + $off] 200 | set bnew [expr [lsearch -sorted -integer $atomidmap $b] + $off] 201 | set cnew [expr [lsearch -sorted -integer $atomidmap $c] + $off] 202 | set dnew [expr [lsearch -sorted -integer $atomidmap $d] + $off] 203 | lappend dihedrallist [list $t $anew $bnew $cnew $dnew] 204 | } 205 | set list [topo getimproperlist -sel $sel] 206 | foreach l $list { 207 | lassign $l t a b c d 208 | set anew [expr [lsearch -sorted -integer $atomidmap $a] + $off] 209 | set bnew [expr [lsearch -sorted -integer $atomidmap $b] + $off] 210 | set cnew [expr [lsearch -sorted -integer $atomidmap $c] + $off] 211 | set dnew [expr [lsearch -sorted -integer $atomidmap $d] + $off] 212 | lappend improperlist [list $t $anew $bnew $cnew $dnew] 213 | } 214 | 215 | set list [topo getcrosstermlist -sel $sel] 216 | foreach l $list { 217 | lassign $l a b c d e f g h 218 | set anew [expr [lsearch -sorted -integer $atomidmap $a] + $off] 219 | set bnew [expr [lsearch -sorted -integer $atomidmap $b] + $off] 220 | set cnew [expr [lsearch -sorted -integer $atomidmap $c] + $off] 221 | set dnew [expr [lsearch -sorted -integer $atomidmap $d] + $off] 222 | set enew [expr [lsearch -sorted -integer $atomidmap $e] + $off] 223 | set fnew [expr [lsearch -sorted -integer $atomidmap $f] + $off] 224 | set gnew [expr [lsearch -sorted -integer $atomidmap $g] + $off] 225 | set hnew [expr [lsearch -sorted -integer $atomidmap $h] + $off] 226 | lappend ctermlist [list $anew $bnew $cnew $dnew $enew $fnew $gnew $hnew] 227 | } 228 | $newsel delete 229 | } 230 | 231 | # apply structure info 232 | topo setbondlist both -molid $mol $bondlist 233 | topo setanglelist -molid $mol $anglelist 234 | topo setdihedrallist -molid $mol $dihedrallist 235 | topo setimproperlist -molid $mol $improperlist 236 | topo setcrosstermlist -molid $mol $ctermlist 237 | # set box to be largest of the available boxes 238 | set amax 0.0 239 | set bmax 0.0 240 | set cmax 0.0 241 | foreach sel $sellist { 242 | lassign [molinfo [$sel molid] get {a b c}] a b c 243 | if {$a > $amax} {set amax $a} 244 | if {$b > $bmax} {set bmax $b} 245 | if {$c > $cmax} {set cmax $c} 246 | } 247 | molinfo $mol set {a b c} [list $amax $bmax $cmax] 248 | 249 | variable newaddsrep 250 | mol reanalyze $mol 251 | if {$newaddsrep} { 252 | adddefaultrep $mol 253 | } 254 | 255 | return $mol 256 | } 257 | 258 | 259 | # create a larger system by replicating the original unitcell 260 | # arguments: molecule id of molecule to replicate 261 | # multiples of the cell vectors defaulting to 1 262 | # support for non-orthogonal cells contributed by Konstantin W 263 | # https://github.com/koniweb/ 264 | # 265 | proc ::TopoTools::replicatemol {mol nx ny nz} { 266 | global M_PI 267 | 268 | if {[string equal $mol top]} { 269 | set mol [molinfo top] 270 | } 271 | 272 | # build translation vectors 273 | set xs [expr {-($nx-1)*0.5}] 274 | set ys [expr {-($ny-1)*0.5}] 275 | set zs [expr {-($nz-1)*0.5}] 276 | set transvecs {} 277 | for {set i 0} {$i < $nx} {incr i} { 278 | for {set j 0} {$j < $ny} {incr j} { 279 | for {set k 0} {$k < $nz} {incr k} { 280 | lappend transvecs [list [expr {$xs + $i}] [expr {$ys + $j}] [expr {$zs + $k}]] 281 | } 282 | } 283 | } 284 | 285 | # compute total number of atoms. 286 | set nrepl [llength $transvecs] 287 | if {!$nrepl} { 288 | vmdcon -err "replicatemol: no or bad nx/ny/nz replications given." 289 | return -1 290 | } 291 | set ntotal 0 292 | set natoms 0 293 | if {[catch {molinfo $mol get numatoms} natoms]} { 294 | vmdcon -err "replicatemol: molecule id $mol does not exist." 295 | return -1 296 | } else { 297 | set ntotal [expr {$natoms * $nrepl}] 298 | } 299 | if {!$natoms} { 300 | vmdcon -err "replicatemol: cannot replicate an empty molecule." 301 | return -1 302 | } 303 | 304 | set molname replicatedmol-$nrepl-x-$mol 305 | set newmol -1 306 | if {[catch {mol new atoms $ntotal} newmol]} { 307 | vmdcon -err "replicatemol: could not create new molecule: $mol" 308 | return -1 309 | } else { 310 | animate dup $newmol 311 | } 312 | mol rename $newmol $molname 313 | 314 | # copy data over piece by piece 315 | set ntotal 0 316 | set bondlist {} 317 | set anglelist {} 318 | set dihedrallist {} 319 | set improperlist {} 320 | set ctermlist {} 321 | 322 | set oldsel [atomselect $mol all] 323 | set obndlist [topo getbondlist both -molid $mol] 324 | set oanglist [topo getanglelist -molid $mol] 325 | set odihlist [topo getdihedrallist -molid $mol] 326 | set oimplist [topo getimproperlist -molid $mol] 327 | set octermlist [topo getcrosstermlist -molid $mol] 328 | 329 | set box [molinfo $mol get {a b c}] 330 | molinfo $newmol set {a b c} [vecmul $box [list $nx $ny $nz]] 331 | set boxtilt [molinfo $mol get {alpha beta gamma}] 332 | molinfo $newmol set {alpha beta gamma} $boxtilt 333 | 334 | foreach v $transvecs { 335 | set newsel [atomselect $newmol \ 336 | "index $ntotal to [expr $ntotal + [$oldsel num] - 1]"] 337 | 338 | # per atom props 339 | set cpylist {name type mass charge radius element x y z \ 340 | resname resid chain segname} 341 | $newsel set $cpylist [$oldsel get $cpylist] 342 | 343 | # calculate movevec for nonorthogonal boxes 344 | set movevec {0.0 0.0 0.0} 345 | set deg2rad [expr $M_PI / 180] 346 | set alpharad [expr [lindex $boxtilt 0] * $deg2rad ] 347 | set betarad [expr [lindex $boxtilt 1] * $deg2rad ] 348 | set gammarad [expr [lindex $boxtilt 2] * $deg2rad ] 349 | set ax [lindex $box 0] 350 | set bx [expr [lindex $box 1] * cos($gammarad) ] 351 | set by [expr [lindex $box 1] * sin($gammarad) ] 352 | set cx [expr [lindex $box 2] * cos($betarad) ] 353 | set cy [expr [lindex $box 2] * [ expr cos($alpharad) -cos($betarad) * cos($gammarad)] / sin($gammarad)] 354 | # calc cz 355 | set V1 [expr [lindex $box 0] * [lindex $box 1] * [lindex $box 2] ] 356 | set V21 [expr 1 - cos($alpharad)*cos($alpharad) \ 357 | - cos($betarad)*cos($betarad) - cos($gammarad)*cos($gammarad) ] 358 | set V22 [expr 2 * [ expr cos($alpharad) * cos($betarad)*cos($gammarad) ] ] 359 | set V [expr $V1 * { sqrt ([ expr $V21 + $V22 ]) } ] 360 | set cz [expr $V / [expr [lindex $box 0] * [lindex $box 1] * sin($gammarad) ] ] 361 | # define vecs as vectors 362 | set avec [list $ax 0.0 0.0] 363 | set bvec [list $bx $by 0.0] 364 | set cvec [list $cx $cy $cz] 365 | set movevec [vecadd \ 366 | [vecscale [lindex $v 0] $avec] \ 367 | [vecscale [lindex $v 1] $bvec] \ 368 | [vecscale [lindex $v 2] $cvec] ] 369 | 370 | $newsel moveby $movevec 371 | # assign structure data. we need to renumber indices 372 | foreach l $obndlist { 373 | lassign $l a b t o 374 | lappend bondlist [list [expr {$a+$ntotal}] [expr {$b+$ntotal}] $t $o] 375 | } 376 | 377 | foreach l $oanglist { 378 | lassign $l t a b c 379 | lappend anglelist [list $t [expr {$a + $ntotal}] [expr {$b + $ntotal}] \ 380 | [expr {$c + $ntotal}]] 381 | } 382 | 383 | foreach l $odihlist { 384 | lassign $l t a b c d 385 | lappend dihedrallist [list $t [expr {$a + $ntotal}] [expr {$b + $ntotal}] \ 386 | [expr {$c + $ntotal}] [expr {$d + $ntotal}]] 387 | } 388 | foreach l $oimplist { 389 | lassign $l t a b c d 390 | lappend improperlist [list $t [expr {$a + $ntotal}] [expr {$b + $ntotal}] \ 391 | [expr {$c + $ntotal}] [expr {$d + $ntotal}]] 392 | } 393 | foreach l $octermlist { 394 | lassign $l a b c d e f g h 395 | lappend ctermlist [list [expr {$a + $ntotal}] [expr {$b + $ntotal}] \ 396 | [expr {$c + $ntotal}] [expr {$d + $ntotal}] \ 397 | [expr {$e + $ntotal}] [expr {$f + $ntotal}] \ 398 | [expr {$g + $ntotal}] [expr {$h + $ntotal}]] 399 | } 400 | incr ntotal [$oldsel num] 401 | $newsel delete 402 | } 403 | # apply structure info 404 | topo setbondlist both -molid $newmol $bondlist 405 | topo setanglelist -molid $newmol $anglelist 406 | topo setdihedrallist -molid $newmol $dihedrallist 407 | topo setimproperlist -molid $newmol $improperlist 408 | topo setcrosstermlist -molid $mol $ctermlist 409 | 410 | variable newaddsrep 411 | mol reanalyze $newmol 412 | if {$newaddsrep} { 413 | adddefaultrep $newmol 414 | } 415 | 416 | $oldsel delete 417 | return $newmol 418 | } 419 | 420 | # rename numerical atom/bond/angle/dihedral/improper types to remain in order 421 | # only works on the entire system 422 | proc ::TopoTools::fixupnumtypes {{mol top} {types all}} { 423 | 424 | set mysel {} 425 | if {[catch {atomselect $mol all} mysel]} { 426 | vmdcon -err "fixupnumtypes: $mysel." 427 | return -1 428 | } 429 | 430 | if {"$types" == "all"} { 431 | set types [list atoms bonds angles dihedrals impropers] 432 | } 433 | 434 | foreach what $types { 435 | set typelist {} 436 | 437 | switch $what { 438 | atom - 439 | atoms { 440 | foreach t [atominfo atomtypenames $mysel] { 441 | if {![string is integer $t]} continue 442 | set s [atomselect [$mysel molid] "type '$t'"] 443 | scan $t {%d} t 444 | $s set type [format {%08d} $t] 445 | $s delete 446 | } 447 | } 448 | 449 | bond - 450 | bonds { 451 | set blist {} 452 | foreach b [bondinfo getbondlist $mysel type] { 453 | set t [lindex $b 2] 454 | if {[string is integer $t]} { 455 | scan $t {%d} t 456 | lappend blist [lreplace $b 2 2 [format {%08d} $t]] 457 | } else {lappend blist $b} 458 | } 459 | setbondlist $mysel type $blist 460 | } 461 | 462 | angle - 463 | angles { 464 | set alist {} 465 | foreach a [angleinfo getanglelist $mysel] { 466 | set t [lindex $a 0] 467 | if {[string is integer $t]} { 468 | scan $t {%d} t 469 | lappend alist [lreplace $a 0 0 [format {%08d} $t]] 470 | } else {lappend alist $a} 471 | } 472 | setanglelist $mysel $alist 473 | } 474 | 475 | dihedral - 476 | dihedrals { 477 | set dlist {} 478 | foreach d [dihedralinfo getdihedrallist $mysel] { 479 | set t [lindex $d 0] 480 | if {[string is integer $t]} { 481 | scan $t {%d} t 482 | lappend dlist [lreplace $d 0 0 [format {%08d} $t]] 483 | } else {lappend dlist $d} 484 | } 485 | setdihedrallist $mysel $dlist 486 | } 487 | 488 | improper - 489 | impropers { 490 | set ilist {} 491 | foreach i [improperinfo getimproperlist $mysel] { 492 | set t [lindex $i 0] 493 | if {[string is integer $t]} { 494 | scan $t {%d} t 495 | lappend ilist [lreplace $i 0 0 [format {%08d} $t]] 496 | } else {lappend ilist $i} 497 | } 498 | setimproperlist $mysel $ilist 499 | } 500 | 501 | default { 502 | vmdcon -err "fixupnumtypes: unsupported type: $what" 503 | return -1 504 | } 505 | } 506 | } 507 | } 508 | 509 | -------------------------------------------------------------------------------- /topovarxyz.tcl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/tclsh 2 | # This file is part of TopoTools, a VMD package to simplify 3 | # manipulating bonds other topology related properties. 4 | # 5 | # Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer 6 | # $Id: topovarxyz.tcl,v 1.6 2020/05/29 19:47:41 johns Exp $ 7 | 8 | # high level subroutines for supporting xyz 9 | # trajectories with a varying number of particles. 10 | # 11 | # import an xmol-format xyz trajectory data file. 12 | # this behaves almost like a molfile plugin and will create a 13 | # new molecule and return its molecule id. 14 | # the special kick is, that this proc will handle .xyz 15 | # files with a varying number of atoms and insert the 16 | # necessary padding atoms and then set the "user" field 17 | # to either 0 or 1 depending on whether the corresponding 18 | # atom is present in the current frame. 19 | # 20 | # Arguments: 21 | # filename = name of data file 22 | # flags = more flags. (currently not used) 23 | proc ::TopoTools::readvarxyz {filename {flags none}} { 24 | if {[catch {open $filename r} fp]} { 25 | vmdcon -err "readvarxyz: problem opening xyz file: $fp\n" 26 | return -1 27 | } 28 | 29 | # initialize local variables 30 | set nframes 0 ; # total number of frames 31 | set typemap {} ; # atom type map 32 | set typecount {} ; # atom type count for one frame 33 | set maxcount {} ; # max. atom type count for all frames 34 | array set traj {} ; # temporary trajectory storage 35 | 36 | # to be able to determine the number of dummy atoms we first 37 | # have to parse and store away the whole trajectory and while 38 | # doing so count the number of atom types in each frame. 39 | while {[gets $fp line] >= 0} { 40 | set numlines -1 41 | if {[regexp {^\s*([0-9]+)} $line x numlines]} { 42 | # first line is number of atoms 43 | } else { 44 | set numlines -1 45 | } 46 | if {$numlines < 0} break 47 | 48 | # skip next line 49 | if {[catch {gets $fp line} msg]} { 50 | vmdcon -err "readvarxyz: error reading frame $nframes of xyz file: $msg. " 51 | break 52 | } 53 | 54 | # collect data for this frame. 55 | set frame {} 56 | for {set i 0} {$i < $numlines} {incr i} { 57 | if {[catch {gets $fp line} msg]} { 58 | vmdcon -err "readvarxyz: error reading frame $nframes of xyz file: $msg. " 59 | break 60 | } 61 | lassign $line a x y z 62 | 63 | # lookup atom type in typemap and add if not found. 64 | set idx [lsearch -exact $typemap $a] 65 | if {$idx < 0} { 66 | set idx [llength $typecount] 67 | lappend typemap $a 68 | lappend typecount 0 69 | lappend maxcount 0 70 | } 71 | lset typecount $idx [expr {[lindex $typecount $idx] + 1}] 72 | lappend frame [list $idx $x $y $z] 73 | } 74 | 75 | # update list of max atoms per type and reset per frame counter. 76 | set newmax {} 77 | set newcount {} 78 | foreach t $typecount m $maxcount { 79 | if {$t > $m} { 80 | lappend newmax $t 81 | } else { 82 | lappend newmax $m 83 | } 84 | lappend newcount 0 85 | } 86 | set maxcount $newmax 87 | set typecount $newcount 88 | 89 | # add frame to storage, sort coordinates by type index. 90 | set traj($nframes) [lsort -integer -index 0 $frame] 91 | incr nframes 92 | } 93 | close $fp 94 | 95 | # determine required number of atoms. 96 | set natoms 0 97 | foreach n $maxcount { 98 | incr natoms $n 99 | } 100 | 101 | vmdcon -info "readvarxyz: read in $nframes frames requiring $natoms atoms storage.\nType map: $typemap\nMax type counts: $maxcount" 102 | 103 | # create an empty molecule and timestep 104 | set mol -1 105 | if {[catch {mol new atoms $natoms} mol]} { 106 | vmdcon -err "readvarxyz: problem creating empty molecule: $mol" 107 | return -1 108 | } 109 | mol rename $mol [file tail $filename] 110 | 111 | # initialize some atom properties 112 | set sel [atomselect $mol all] 113 | set aname {} 114 | foreach t $typemap n $maxcount { 115 | for {set i 0} {$i < $n} {incr i} { 116 | lappend aname $t 117 | } 118 | } 119 | $sel set name $aname 120 | $sel set type $aname 121 | guessatomdata $sel element name 122 | guessatomdata $sel radius element 123 | guessatomdata $sel mass element 124 | 125 | for {set i 0} {$i < $nframes} {incr i} { 126 | animate dup $mol 127 | set data {} 128 | set idx -1 129 | set count [lindex $maxcount $idx] 130 | set j 0 131 | foreach c $traj($i) { 132 | while {[lindex $c 0] > $idx} { 133 | incr idx 134 | for {set k $j} {$k < $count} {incr k} { 135 | lappend data {0.0 0.0 0.0 -1.0} 136 | } 137 | set count [lindex $maxcount $idx] 138 | set j 0 139 | } 140 | incr j 141 | set line [lrange $c 1 end] 142 | lappend line 1.0 143 | lappend data $line 144 | } 145 | for {set k $j} {$k < $count} {incr k} { 146 | lappend data {0.0 0.0 0.0 -1.0} 147 | } 148 | incr idx 149 | while {$idx < [llength $maxcount]} { 150 | set count [lindex $maxcount $idx] 151 | for {set j 0} {$j < $count} {incr j} { 152 | lappend data {0.0 0.0 0.0 -1.0} 153 | } 154 | incr idx 155 | } 156 | $sel set {x y z user} $data 157 | } 158 | mol reanalyze $mol 159 | 160 | # add default representation 161 | # to make this work we have to add "user > 0" 162 | # to the selection string and have the selection 163 | # being re-evaluated in every step. 164 | variable newaddsrep 165 | if {$newaddsrep} { 166 | adddefaultrep $mol "user > 0" 167 | mol selupdate 0 $mol on 168 | } 169 | return $mol 170 | } 171 | 172 | # Arguments: 173 | # filename = name of data file 174 | # flags = more flags. (currently not used) 175 | proc ::TopoTools::writevarxyz {filename mol sel {flags {}}} { 176 | if {[catch {open $filename w} fp]} { 177 | vmdcon -err "writevarxyz: problem opening xyz file: $fp\n" 178 | return -1 179 | } 180 | 181 | # largest possible frame number 182 | set maxframe [molinfo $mol get numframes] 183 | incr maxframe -1 184 | 185 | set first 0 186 | set last $maxframe 187 | set step 1 188 | set nframe 0 189 | set selmod {user > 0} 190 | 191 | # parse optional flags 192 | foreach {key value} $flags { 193 | switch -- $key { 194 | first {set first $value} 195 | last {set last $value} 196 | step {set step $value} 197 | selmod {set selmod $value} 198 | default { 199 | vmdcon -err "writevarxyz: unknown flag: $key" 200 | return -1 201 | } 202 | } 203 | } 204 | 205 | set writesel [atomselect $mol "([$sel text]) and $selmod"] 206 | for {set i $first} {$i <= $last} {incr i $step} { 207 | if {$i > $maxframe} continue 208 | 209 | $writesel frame $i 210 | $writesel update 211 | 212 | puts $fp [$writesel num] 213 | puts $fp " Frame: $nframe" 214 | foreach line [$writesel get {name x y z}] { 215 | puts $fp $line 216 | } 217 | incr nframe 218 | } 219 | close $fp 220 | 221 | $writesel delete 222 | return $nframe 223 | } 224 | 225 | --------------------------------------------------------------------------------