INitial commit of CAC code

docs/Commands/boundary.md

@@ -0,0 +1,22 @@
+# boundary
+
+```sh
+boundary xyz
+```
+
+## Inputs
+
+`xyz` - string describing the boundary conditions in which `x`, `y`, and `z` can have values of either `p` for periodic or `s` for shrink-wrapped.
+
+## Examples
+
+```sh
+boundary ppp
+boundary sps
+```
+
+## Description 
+
+Boundary sets the boundary conditions of the model being either periodic or shrink-wrapped. 
+Because boundary data is included within the restart file format, this command is not strictly required.
+If included this command will override the boundary conditions defined within the data file.

docs/Commands/dump.md

@@ -0,0 +1,23 @@
+# dump
+
+```sh
+dump id group style n fname
+```
+
+## Inputs
+
+`id` - id for dump command
+
+`group` - group to be dumped
+
+`style` - dump style, currently only accepts `out`
+
+`n` - dump every `n` steps. If `n` is `0` then the dump file is only written at the beginning and end of a minimize or run.
+
+`fname` - file name to write to. Will strip extensions and replace with the timestep and .out. 
+
+## Example
+
+```
+
+```

docs/Commands/group.md

@@ -0,0 +1,52 @@
+# group
+
+```sh
+group id selection shape ...
+```
+
+## Inputs 
+
+`id` - assigned id for the group.
+
+`selection` - either `atoms`, `elements`, or `all`. 
+
+`shape` - either `block`, `sphere`, or `type`.
+
+**Additional arguments depend on the group shape passed and are listed below:** 
+
+```sh
+group id selection block xlo xhi ylo yhi zlo zhi
+```
+where `{x,y,z}lo` are the lower bounds along `x,y,z` and `{x,y,z}hi` are the upper bounds along `x,y,z`.
+
+```sh
+group id selection sphere x y z r
+```
+where `x y z` define the centroid of the sphere and `r` defines the radius of the sphere.
+
+```sh
+group id selection type n
+```
+where `n` is a number which selects the `n`th atom type.
+
+## Examples
+```sh
+group tophalf all block -inf inf -inf inf inf*0.5 inf
+group precip atoms sphere 100 78 78 10
+group Ni atoms type 2
+```
+
+## Description
+
+The group option is used in conjunction with other commands which require a group input. 
+**A default `all` group is defined which contains all atoms and elements.**
+A subsection of all atoms or elements can be selected using the group command.
+`id` is used to refer to the group in other commands.
+`selection` determines which element types are selected within the group. 
+A group can be defined containing only `atoms`, `elements`, or `both`. 
+If element types are within the bounds of the group but are not specified with `selection` they are not defined as members of the group.
+
+All positions for the group command can be specified using position specifications described [here](../Misc/position.md).
+
+
+

docs/Commands/min_style.md

@@ -0,0 +1,25 @@
+# min_style
+
+```sh
+min_style minimizer
+```
+
+## Inputs
+
+`minimizer` - Either `fire` or `cg`.
+
+## Examples
+
+```sh
+min_style fire
+min_style cg
+```
+
+## Description
+
+This code sets the minimizer for future `minimize` commands.
+Currently CAC has implemented both conjugate gradient minimization, `cg`, and the fast inertial relaxation engine [1], `fire`. 
+
+## References
+
+[1] Guénolé, Julien et al. "Assessment and optimization of the fast inertial relaxation engine (fire) for energy minimization in atomistic simulations and its implementation in lammps" Computational Materials Science (2020)

docs/Commands/minimize.md

@@ -0,0 +1,31 @@
+# minimize 
+
+```sh
+minimize ftol etol max_iter
+```
+
+## Inputs
+
+`ftol` - force tolerance
+
+`etol` - energy tolerance
+
+`max_iter` - maximum number of iterations to calculate before exiting.
+
+## Examples
+
+```sh
+minimize 10d-10 10d-10 10000
+```
+
+## Description
+
+The minimize command is used to perform energy minimization on the CAC model. 
+The minimization method is chosen by the [min_style](./min_style.md) command. 
+Minimization is considered to be complete under the following conditions:
+
+1. \( \frac{(E_i - E_{i-1})}{E_i} < etol \), where \( i \) is the current iteration.
+2. No atom has a force component greater than `ftol`
+3. The number of iterations is greater than `max_iter`
+
+

docs/Commands/neighbor.md

@@ -0,0 +1,21 @@
+# neighbor
+
+```sh
+neighbor skin
+```
+
+## Inputs
+
+`skin` - The skin distance in angstrom added to the cutoff radius for construction of verlet lists.
+
+## Examples
+
+```sh
+neighbor 1.5
+```
+
+## Description
+
+This command specifies the additional skin distance which is used when constructing the verlet neighbor lists.
+When an atom has moved greater than the half of the skin distance, then the neighbor lists are reconstructed.
+

docs/Commands/potential.md

@@ -0,0 +1,29 @@
+# potential
+
+```sh
+potential pot_type file elements ...
+```
+
+## Inputs
+
+`pot_type` - Potential type, currently accepts either "eam" for setfl formatted eam/alloy potentials, or "fs" for eam finnis sinclair style potentials.
+`file` - Potential file, currently only accepts .eam.alloy style potential files
+
+`elements ...` - List of atomic elements mapping the atom type number to atomic species. Can be excluded resulting in mapping atomic types based on ordering within the potential file.
+
+## Examples
+
+```sh
+potential CuNi.eam.alloy Ni Cu
+potential Cu_mishin1.eam.alloy 
+```
+
+## Description
+
+This command specifies the potential information.
+**Currently only .eam.alloy style potentials are accepted.** 
+The `elements ...` portion of the code is used to map the numeric atom type to the potential file.
+For the first example, `Ni Cu` maps atoms with type 1 to Ni and atoms with type 2 to Cu.
+Inputting `Cu Ni` would instead reverse the order and map atoms with type 1 to Cu and vice-versa.
+This can be excluded, as in the second example.
+If the CuNi.eam.alloy file is ordered with Ni first and Cu second, then `potential CuNi.eam.alloy Ni Cu` is equivalent to `potential CuNi.eam.alloy`.

docs/Commands/read_data.md

@@ -0,0 +1,24 @@
+# read_data
+
+```
+read_data filename
+```
+
+## Inputs 
+
+`filename` - Input file to be read in restart format.
+
+## Examples 
+
+```sh
+read_data model_1.restart
+```
+
+## Description
+
+Model building capabilities are not included into the CAC simulation tool. 
+Instead the [CAC model builder (CACmb)](https://gitlab.com/aselimov/cacmb) must be used to create models in the .restart format.
+The read_data command reads in one .restart formatted data file and distributes the model across all processors.
+
+
+

docs/Commands/run.md

@@ -0,0 +1,10 @@
+# run 
+```sh
+run ensemble timesteps
+```
+
+## Inputs
+
+`ensemble` - currently either `nve` or `qd`.
+
+`timesteps` - The number of timesteps to run of dynamics

docs/Commands/setforce.md

@@ -0,0 +1,9 @@
+# setforce
+
+```
+setforce group_id fx fy fz
+```
+
+## Inputs
+
+`group_id` - id for student

docs/Commands/temp.md

@@ -0,0 +1,26 @@
+# temp
+
+```sh
+temp command group_id args
+```
+
+## Inputs
+
+`command`  - Command for temp option, either `create` or `control`.
+
+`group_id` - Group id to apply temperature control to 
+
+**Additional arguments depend on the command passed and are listed below** 
+
+```sh
+temp create group_id T_target
+```
+
+- `T_target` - Target temperature
+
+```sh
+temp control group_id T_target time_constant
+```
+
+- `T_target` - Target temperature 
+- `time_constant` - time constant 

docs/Commands/thermo.md

@@ -0,0 +1,22 @@
+# thermo
+
+```sh
+thermo step
+```
+
+## Inputs
+
+`step` - Output every `step` steps.
+
+## Examples
+
+```
+thermo 50
+```
+
+## Descriptions
+
+Currently the thermo output is fixed. 
+For energy minimization, the thermo output contains only the energy and second norm of the global force vector.
+For dynamics, the thermo output also contains the kinetic energy and the temperature.
+

docs/Commands/thermo_style.md

@@ -0,0 +1,32 @@
+# thermo_style
+
+```sh
+thermo_style args
+```
+
+## Inputs
+
+`args` - List of thermo_style options. Acceptable options are listed below:
+
+## Examples
+
+```
+thermo 50
+```
+
+## Descriptions
+
+The `thermo_style` command sets the thermo output for CAC. 
+By default the thermostyle command only outputs the potential energy and the global force norm.
+Acceptable options for thermo_style are listed below:
+
+- `pe`: potential energy
+- `fnorm`: global force norm
+- `temp`: temperature
+- `temp_c`: temperature in CG 
+- `temp_a`: temperature in atoms
+- `ke`: kinetic energy
+- `ke_c`: kinetic energy in CG 
+- `ke_a`: kinetic energy in atoms
+- `lx`, `ly`, `lz`: Box dimensions in x, y, z respectively
+- `px`, `py`, `pz`: Box pressure in x, y, z respectively

docs/index.md

@@ -0,0 +1,16 @@
+# CAC: An implementation of the Concurrent Atomistic-Continuum method
+
+Copyright © 2017-2018 Georgia Institute of Technology. All Rights Reserved.
+
+CAC is an implementation of the concurrent atomistic-continuum (CAC) method [1] that allows for both dynamics and energy minimization of CAC models.
+CAC is written in Fortran 2008. 
+For a standalone tool used to build and analyze models for simulation with CAC please see the [CAC model builder tool](https://gitlab.com/aselimov/cacmb).
+
+This user's manual is maintained by [Alex Selimov](https://alexselimov.xyz) and [Kevin Chu](https://kvnchv.github.io/cv/). Both are current Ph.D. students of Prof. David L. McDowell at the Georgia Institute of Technology.
+
+
+Click [here](./intro/getstarted.md) for the getting started guide.
+
+## References
+
+[1] Chen, Youping et al. "Concurrent atomistic-continuum modeling of crystalline materials" Journal of Applied Physics (2019)

docs/intro/getstarted.md

@@ -0,0 +1 @@
+# Getting Started

src/Makefile

@@ -0,0 +1,122 @@
+.DEFAULT_GOAL := all
+
+FC=mpif90
+OBJDIR=obj
+SRCS := $(wildcard *.f90)
+OBJECTS := $(addprefix $(OBJDIR)/,$(SRCS:%.f90=%.o))
+FFLAGS=-Wall -mcmodel=large -O2 -g -fbacktrace -fcheck=all -ffpe-trap=invalid,zero,overflow,underflow,denormal -J$(OBJDIR)
+#
+#FFLAGS=-O3 -g -J$(OBJDIR) 
+
+#----------------- DEPENDENCIES -----------------#
+# GENERATED USING https://github.com/ZedThree/fort_depend.py **requires python3**
+# > pip install fortdepend
+# > fortdepend -o Makefile.dep -i mpi -b obj/
+include Makefile.dep
+
+#----------------- DEFAULTS -----------------#
+	
+all: CAC
+
+.PHONY: deps
+CAC: $(OBJECTS) $(OBJDIR)/main.o
+	$(FC) $(FFLAGS) $(OBJECTS) -o $@
+
+$(OBJDIR)/%.o: %.f90
+	@mkdir -p $(@D) 
+	$(FC) $(FFLAGS) -c -o $@ $< 
+
+.f90.o: 
+	$(FC) $(FFLAGS) -c $< 
+
+
+#deps:
+#	@fortdepend -o Makefile.dep -i mpi -b obj -w
+
+deps:
+	@makedepf90 -b obj *.f90 > Makefile.dep
+#----------------- TEST RULES -----------------#
+
+COMMS_TEST_OBJECTS := $(addprefix $(OBJDIR)/,$(COMMS_TEST))
+
+MULTICOMM_TEST:=$(COMMS_TEST)
+MULTICOMM_TEST_OBJECTS:=$(addprefix $(OBJDIR)/,$(MULTICOMM_TEST))
+
+ELEMENTS_TEST=parameters.o elements.o box.o errors.o math.o logger.o
+ELEMENTS_TEST_OBJECTS := $(addprefix $(OBJDIR)/,$(ELEMENTS_TEST))
+
+
+DUMP_TEST=$(POT_TEST) dump.o
+DUMP_TEST_OBJECTS := $(addprefix $(OBJDIR)/,$(DUMP_TEST))
+
+
+
+.PHONY:	tests
+tests: test_cohesive_energy test_gsf test_pair_force test_multi_pair_force test_fs_pair_force test_cg_calc test_mixed_potentials
+
+test_cohesive_energy: $(OBJECTS)
+	$(eval TESTOBJECTS := $(filter-out $(OBJDIR)/main.o,$(OBJECTS)))
+	@cp $(TESTOBJECTS) ./tests/cohesive_energy
+	@cp $(subst .o,.mod,$(TESTOBJECTS)) ./tests/cohesive_energy
+	$(MAKE) -C ./tests/cohesive_energy
+
+test_gsf: $(OBJECTS)
+	$(eval TESTOBJECTS := $(filter-out $(OBJDIR)/main.o,$(OBJECTS)))
+	@cp $(TESTOBJECTS) ./tests/gsf
+	@cp $(subst .o,.mod,$(TESTOBJECTS)) ./tests/gsf
+	$(MAKE) -C ./tests/gsf
+
+test_pair_force: $(OBJECTS)
+	$(eval TESTOBJECTS := $(filter-out $(OBJDIR)/main.o,$(OBJECTS)))
+	@cp $(TESTOBJECTS) ./tests/pair_force
+	@cp $(subst .o,.mod,$(TESTOBJECTS)) ./tests/pair_force
+	$(MAKE) -C ./tests/pair_force
+
+test_multi_pair_force: $(OBJECTS)
+	$(eval TESTOBJECTS := $(filter-out $(OBJDIR)/main.o,$(OBJECTS)))
+	@cp $(TESTOBJECTS) ./tests/multi_pair_force
+	@cp $(subst .o,.mod,$(TESTOBJECTS)) ./tests/multi_pair_force
+	$(MAKE) -C ./tests/multi_pair_force
+
+test_fs_pair_force: $(OBJECTS)
+	$(eval TESTOBJECTS := $(filter-out $(OBJDIR)/main.o,$(OBJECTS)))
+	@cp $(TESTOBJECTS) ./tests/fs_pair_force
+	@cp $(subst .o,.mod,$(TESTOBJECTS)) ./tests/fs_pair_force
+	$(MAKE) -C ./tests/fs_pair_force
+
+test_morse_force: $(OBJECTS)
+	$(eval TESTOBJECTS := $(filter-out $(OBJDIR)/main.o,$(OBJECTS)))
+	@cp $(TESTOBJECTS) ./tests/morse_force
+	@cp $(subst .o,.mod,$(TESTOBJECTS)) ./tests/morse_force
+	$(MAKE) -C ./tests/morse_force
+
+test_cg_calc: $(OBJECTS)
+	$(eval TESTOBJECTS := $(filter-out $(OBJDIR)/main.o,$(OBJECTS)))
+	@cp $(TESTOBJECTS) ./tests/cg_calc
+	@cp $(subst .o,.mod,$(TESTOBJECTS)) ./tests/cg_calc
+	$(MAKE) -C ./tests/cg_calc
+
+
+test_mixed_potential: $(OBJECTS)
+	$(eval TESTOBJECTS := $(filter-out $(OBJDIR)/main.o,$(OBJECTS)))
+	@cp $(TESTOBJECTS) ./tests/mixed_potentials
+	@cp $(subst .o,.mod,$(TESTOBJECTS)) ./tests/mixed_potentials
+	$(MAKE) -C ./tests/mixed_potentials
+
+#----------------- CLEAN UP -----------------#
+
+.PHONY: clean
+clean:
+	$(RM) *.mod *.o
+	$(RM) $(OBJDIR)/*.mod $(OBJDIR)/*.o CAC
+	@$(RM) -rf obj/
+
+.PHONY: cleantest
+cleantest:
+	$(RM) tests/*/*.o tests/*/*.mod tests/*/*_test
+
+.PHONY: clean-all
+clean-all: clean cleantest
+
+# DEBUGGING VARIABLE PRINT
+print-%  : ; @echo $* = $($*)

src/Makefile.dep

@@ -0,0 +1,39 @@
+obj/atom_types.o : atom_types.f90 obj/str.o obj/logger.o obj/parameters.o 
+obj/berendsen.o : berendsen.f90 obj/time.o obj/forces.o obj/compute.o obj/parameters.o obj/elements.o 
+obj/box.o : box.f90 obj/errors.o obj/parameters.o 
+obj/cg.o : cg.f90 obj/min_arrays.o obj/integration.o obj/potential.o obj/neighbors.o obj/atom_types.o obj/time.o obj/forces.o obj/elements.o obj/comms.o obj/parameters.o 
+obj/comms.o : comms.f90 obj/math.o obj/errors.o obj/box.o obj/elements.o obj/parameters.o 
+obj/compute.o : compute.f90 obj/box.o obj/group.o obj/elements.o obj/forces.o obj/atom_types.o obj/comms.o obj/parameters.o 
+obj/debug.o : debug.f90 obj/str.o obj/elements.o obj/forces.o obj/parameters.o 
+obj/deform.o : deform.f90 obj/comms.o obj/time.o obj/neighbors.o obj/elements.o obj/box.o obj/parameters.o 
+obj/displace.o : displace.f90 obj/neighbors.o obj/time.o obj/str.o obj/group.o obj/elements.o obj/parameters.o obj/forces.o 
+obj/dump.o : dump.f90 obj/time.o obj/group.o obj/math.o obj/forces.o obj/errors.o obj/box.o obj/elements.o obj/comms.o obj/parameters.o obj/atom_types.o 
+obj/dynamics.o : dynamics.f90 obj/deform.o obj/berendsen.o obj/temp.o obj/time.o obj/thermo.o obj/dump.o obj/potential.o obj/comms.o obj/forces.o obj/quenched_dynamics.o obj/neighbors.o obj/vel_verlet.o obj/parameters.o 
+obj/eam.o : eam.f90 obj/atom_types.o obj/errors.o obj/comms.o obj/neighbors.o obj/integration.o obj/elements.o obj/forces.o obj/math.o obj/parameters.o 
+obj/elements.o : elements.f90 obj/math.o obj/box.o obj/errors.o obj/parameters.o 
+obj/errors.o : errors.f90 obj/logger.o obj/parameters.o 
+obj/fire.o : fire.f90 obj/debug.o obj/potential.o obj/neighbors.o obj/atom_types.o obj/time.o obj/forces.o obj/elements.o obj/comms.o obj/parameters.o 
+obj/force_mod.o : force_mod.f90 obj/time.o obj/str.o obj/group.o obj/elements.o obj/parameters.o obj/forces.o 
+obj/forces.o : forces.f90 obj/integration.o obj/elements.o obj/parameters.o 
+obj/group.o : group.f90 obj/comms.o obj/str.o obj/box.o obj/elements.o obj/parameters.o 
+obj/input_parser.o : input_parser.f90 obj/langevin.o obj/modify.o obj/deform.o obj/set.o obj/displace.o obj/force_mod.o obj/minimize.o obj/group.o obj/dump.o obj/logger.o obj/neighbors.o obj/read_data.o obj/eam.o obj/potential.o obj/parameters.o obj/comms.o 
+obj/integration.o : integration.f90 obj/errors.o obj/elements.o obj/comms.o obj/parameters.o 
+obj/langevin.o : langevin.f90 obj/group.o obj/atom_types.o obj/time.o obj/forces.o obj/elements.o obj/comms.o obj/parameters.o 
+obj/logger.o : logger.f90 obj/parameters.o 
+obj/main.o : main.f90 obj/langevin.o obj/deform.o obj/debug.o obj/potential.o obj/berendsen.o obj/temp.o obj/thermo.o obj/dump.o obj/group.o obj/time.o obj/minimize.o obj/logger.o obj/neighbors.o obj/integration.o obj/input_parser.o obj/parameters.o obj/comms.o 
+obj/math.o : math.f90 obj/parameters.o 
+obj/min_arrays.o : min_arrays.f90 obj/errors.o obj/elements.o obj/parameters.o 
+obj/minimize.o : minimize.f90 obj/debug.o obj/logger.o obj/errors.o obj/thermo.o obj/dump.o obj/potential.o obj/comms.o obj/forces.o obj/neighbors.o obj/cg.o obj/fire.o obj/parameters.o 
+obj/modify.o : modify.f90 obj/potential.o obj/elements.o obj/neighbors.o obj/parameters.o 
+obj/morse.o : morse.f90 obj/atom_types.o obj/errors.o obj/comms.o obj/neighbors.o obj/integration.o obj/elements.o obj/forces.o obj/math.o obj/parameters.o 
+obj/neighbors.o : neighbors.f90 obj/min_arrays.o obj/temp.o obj/group.o obj/elements.o obj/forces.o obj/logger.o obj/comms.o obj/math.o obj/integration.o obj/parameters.o 
+obj/parameters.o : parameters.f90 
+obj/potential.o : potential.f90 obj/force_mod.o obj/atom_types.o obj/str.o obj/comms.o obj/forces.o obj/morse.o obj/eam.o obj/parameters.o 
+obj/quenched_dynamics.o : quenched_dynamics.f90 obj/vel_verlet.o obj/time.o obj/potential.o obj/neighbors.o obj/elements.o obj/comms.o obj/parameters.o 
+obj/read_data.o : read_data.f90 obj/time.o obj/str.o obj/logger.o obj/comms.o obj/dynamics.o obj/potential.o obj/integration.o obj/box.o obj/elements.o obj/parameters.o obj/math.o 
+obj/set.o : set.f90 obj/logger.o obj/group.o obj/elements.o 
+obj/str.o : str.f90 
+obj/temp.o : temp.f90 obj/atom_types.o obj/time.o obj/compute.o obj/group.o obj/elements.o obj/comms.o obj/parameters.o 
+obj/thermo.o : thermo.f90 obj/str.o obj/compute.o obj/forces.o obj/elements.o 
+obj/time.o : time.f90 obj/errors.o obj/logger.o obj/parameters.o 
+obj/vel_verlet.o : vel_verlet.f90 obj/time.o obj/potential.o obj/neighbors.o obj/elements.o obj/comms.o obj/parameters.o 

src/atom_types.f90

@@ -0,0 +1,87 @@
+module atom_types
+    !This module contains the atom type variables
+    use parameters
+    use logger
+    use str
+    implicit none
+
+
+    !Max number of atom types allowed 
+    integer, parameter :: max_atom_types=10
+    !number of different potential types, eam all count for the same
+    integer, parameter :: max_pot_types=2
+    !Atom type variables
+    integer, save ::  natom_types
+    real(kind=wp), dimension(max_atom_types), save  :: masses
+    character(len=2), dimension(max_atom_types), save :: atom_names
+    !Have to move some potential variables here
+    integer, save, dimension(max_atom_types, max_atom_types) :: types_to_pot_type
+    logical, dimension(max_pot_types) :: potential_types
+    logical :: atom_types_set
+
+    public
+    contains
+
+    subroutine init_atom_types 
+        !Initialization subroutine
+        atom_types_set = .false.
+        types_to_pot_type=0
+    end subroutine init_atom_types
+
+    subroutine set_atom_types(num,names)
+        !This subroutine sets the atom types for use with the potential functions
+        integer, intent(in) :: num
+        character(len=2), dimension(:) :: names
+        integer :: i
+
+        natom_types = num
+        do i = 1, natom_types
+            atom_names(i) = names(i)
+        end do 
+        atom_types_set = .true.
+
+        return
+    end subroutine set_atom_types
+
+    subroutine parse_types(line)
+        character(len=*), intent(in) :: line
+        character(len=read_len) :: tmptxt
+        integer :: i
+
+        i = tok_count(line)
+        natom_types = i-1
+        read(line,*) tmptxt, (atom_names(i), i = 1, natom_types)
+
+        atom_types_set = .true.
+        return
+    end subroutine parse_types
+
+    subroutine parse_mass(line)
+        character(len=*), intent(in) :: line
+        character(len=read_len) :: tmptxt
+        integer :: i
+        real(kind=wp) :: m
+
+        read(line,*) tmptxt, i, m
+
+        masses(i) = m
+
+        write(tmptxt, *) "Masses are now: ", masses(1:natom_types)
+        call log_msg(tmptxt)
+    
+        return
+    end subroutine parse_mass
+
+    subroutine log_types
+        !This command logs the atom_types to the log file
+        integer :: i
+        character(len = read_len) :: msg
+        msg = ''
+        do i = 1, natom_types
+            write(msg, *) trim(adjustl(msg)), i, atom_names(i)
+        end do
+
+        call log_msg("Atom types are mapped as "//msg)
+    end subroutine log_types
+end module atom_types
+

src/berendsen.f90

@@ -0,0 +1,122 @@
+module berendsen
+    use elements
+    use parameters
+    use compute
+    use forces
+    use time
+
+    implicit none
+
+    real(kind=wp), save, private:: Ptarget(3), time_constant
+    logical, save :: pflag, need_barostat(3)
+    public 
+    contains
+
+    subroutine parse_berendsen(line)
+        !This subroutine parses the press command
+        character(len=*), intent(in) :: line
+        character(len = read_len) :: tmptxt, msg, press_targets(3)
+        integer :: iospara, i
+
+        read(line, *, iomsg = msg, iostat = iospara) tmptxt, time_constant, (press_targets(i), i = 1, 3)
+        if(iospara > 0) call read_error(msg, iospara)
+
+        need_barostat=.false.
+        do i = 1,  3
+            if ((trim(adjustl(press_targets(i))) == 'null').or.(trim(adjustl(press_targets(i))) == 'NULL')) then 
+                Ptarget(i)=0
+            else
+                read(press_targets(i), *) Ptarget(i)
+                need_barostat(i)=.true.
+            end if
+        end do
+        pflag = .true.
+
+        write(msg, *) "Using Berendsen barostat to target pressure ", Ptarget, " for dimensions", need_barostat
+        call log_msg(msg)
+        return
+    end subroutine parse_berendsen
+
+    subroutine rescale_box
+        !This function actually rescales the box for barostatting.
+        integer :: i, j
+        real(kind = wp) :: pressure(3,3), identity(3,3), mu(3,3), cntr(3), cdamp
+
+        !First compute the box pressure
+        pressure = compute_box_press()
+
+        !Initialize some needed variables 
+        identity(:,:) = 0.0_wp
+        forall(i=1:3) identity(i,i) = 1.0_wp
+        mu(:,:) = 0.0_wp
+
+        !Now calculate the scaling factor
+        cdamp = time_step/time_constant
+        forall(i=1:3)mu(i,i) = (identity(i,i) - cdamp*(Ptarget(i) - pressure(i,i)))**(1.0_wp/3.0_wp)
+        !We set the scaling factor  to 1 in non-periodic dimensions
+        do i = 1, 3
+            if ((.not.period(i)).or.(.not.need_barostat(i))) mu(i,i) = 1.0_wp
+        end do
+        !Now get the box center
+        cntr = 0.0_wp
+        do i = 1,3
+            cntr(i) = box_length(i)/2 + box_bd(2*i-1)
+        end do
+        !Now scale the box boundaries
+        do i = 1, 6
+            j = (i+1)/2
+            box_bd(i) = cntr(j) + mu(j,j)*(box_bd(i)-cntr(j)) 
+        end do
+
+        !update box length
+        do i = 1, 3
+            box_length(i) = box_bd(2*i) - box_bd(2*i-1)
+        end do
+
+        !Now scale the atomic and nodal positions
+        if(atom_num > 0) then
+            do i = 1, atom_num_l
+                do j = 1, 3
+                    r_atom(j,i) = cntr(j) + mu(j,j)*(r_atom(j,i)-cntr(j))
+                end do
+            end do
+        end if
+        if(ele_num > 0) then 
+            do i = 1, node_num_l
+                do j=1, 3
+                    r(j,:,i) = cntr(j) + mu(j,j)*(r(j,:,i)-cntr(j))
+                end do
+            end do
+        end if
+
+        !Now scale the box matrix
+        box_mat = matmul(box_mat,mu)
+
+        !Now update the processor boundaries
+        pro_length(:) = 0.0_wp
+        pro_bd(:) = 0.0_wp
+
+        do i = 1, 3
+            !Define processor boundaries
+            pro_length(i) = box_length(i) / num_pro(i)
+            pro_bd(2*i-1) = box_bd(2*i-1) + grid_coords(i) * pro_length(i)
+            pro_bd(2*i) = box_bd(2*i-1) + (grid_coords(i) + 1) * pro_length(i)
+
+            if(grid_coords(i) == 0) then
+                !If the processor has coordinate 0 it's the bottom one so set the boundary equal to the box boundary
+                pro_bd(2*i-1) = box_bd(2*i-1)
+            end if
+
+            if(grid_coords(i) == num_pro(i) - 1) then
+                !If the processor has coordinate num_pro(i) - 1 it's the top one so set the boundary equal to top boundary
+                pro_bd(2*i) = box_bd(2*i)
+            end if
+
+            pro_length(i) = pro_bd(2*i) - pro_bd(2*i-1)
+        end do
+        call processor_bds
+
+        return
+    end subroutine rescale_box
+
+end module berendsen

src/box.f90

@@ -0,0 +1,197 @@
+
+module box
+    !This module contains all information related to simulation box definitions
+   
+    use parameters
+    use errors
+
+    implicit none
+    
+    !Box definition variables
+    real(kind=wp) :: box_bd(6), orig_box_bd(6), box_length(3), orig_box_length(3)
+    real(kind=wp) :: box_mat_ori(3,3), box_mat(3,3)
+    !Boundary definitions
+    character(len=3) :: boundary
+    logical :: periodic
+    logical, dimension(3) :: period
+
+    real(kind=wp), dimension(3) :: center_mass, center_mass_ori, center_mass_disp
+
+    public 
+    contains
+
+    subroutine parse_boundary(line)
+        !This subroutine parses the optional boundary command
+        character(len=*), intent(in) :: line
+        integer :: iospara, i
+        character(len=read_len) :: msg, tmptxt
+        read(line, *, iostat = iospara, iomsg = msg) tmptxt, boundary
+        if(iospara > 0) call read_error(msg, iospara)
+
+        do i = 1, 3
+            select case(boundary(i:i))
+            case('s', 'S')
+                period(i) = .false.
+            case('p','P')
+                period(i) = .true.
+            case default
+                call command_error("Boundary must be either p or s")
+            end select
+        end do
+
+        if(any(period)) then
+            periodic = .true.
+            if(.not.allocated(pb_node))then
+                allocate(pb_node(3,max_basisnum, node_num_lr))
+            end if
+        else 
+            periodic = .false.
+        end if
+
+
+    end subroutine parse_boundary
+
+    subroutine cross_pb(r, info)
+        !This subroutine sets which periodic boundaries the nodes have crossed
+        real(kind = wp), dimension(3), intent(inout) :: r
+        integer, dimension(3), intent(out) :: info
+
+        integer :: i
+
+        info(:) = 0
+        do i = 1, 3
+            if(period(i).eqv..true.) then
+                if(r(i) < box_bd(i*2-1)) then
+                    r(i) = r(i) + box_length(i)
+                    info(i) = 1
+
+                else if(r(i) > box_bd(i*2)) then
+                    r(i) = r(i) - box_length(i)
+                    info(i) = -1
+
+                end if
+            end if
+        end do
+        return 
+    end subroutine cross_pb
+
+    subroutine restore_pb(r_in, pb_move, ipb)
+
+        real(kind = wp), dimension(3), intent(inout) :: r_in
+        integer, dimension(3), intent(in) :: pb_move
+        logical, optional, intent(out) :: ipb
+
+        integer :: i
+
+        if(present(ipb)) ipb = .false.
+        do i = 1, 3
+            if((period(i).eqv..true.).and. (pb_move(i) /= 0)) then
+                r_in(i) = r_in(i) - pb_move(i) * box_length(i)
+                if(present(ipb)) ipb = .true.
+            end if
+       end do
+
+       return
+    end subroutine restore_pb
+
+    function in_box_bd(r)
+        !this function just checks to make sure position r is within the overall simulation box
+        real(kind=wp), intent(in) :: r(3)
+        logical :: in_box_bd
+
+        integer :: i
+        in_box_bd = .true.
+        do i = 1,3
+            if (r(i) < box_bd(2*i-1)) then 
+                !Lower bound
+                in_box_bd = .false.
+                return
+            else if (r(i) > box_bd(2*i)) then 
+                !Upper bound
+                in_box_bd = .false.
+                return
+            end if
+        end do
+
+        return
+    end function in_box_bd
+
+    recursive subroutine parse_pos(i, pos_string, pos)
+        !This subroutine parses the pos command allowing for command which include inf
+        integer, intent(in) ::  i !The dimension of the position
+        character(len=*), intent(in) :: pos_string !The position string
+        real(kind=dp), intent(out) :: pos !The output parsed position value
+
+        integer :: iospara
+        real(kind=dp) :: rand, rone, rtwo
+        character(len=100) :: cone, ctwo
+
+        iospara = 0
+        
+        if(trim(adjustl(pos_string)) == 'inf') then 
+            pos=box_bd(2*i)
+
+        else if(trim(adjustl(pos_string)) == '-inf') then
+            pos=box_bd(2*i-1)
+
+        else if (trim(adjustl(pos_string)) == 'rand') then 
+            call random_number(rand)
+            pos = (box_bd(2*i)-box_bd(2*i-1))*rand + box_bd(2*i-1)
+
+        else if (index(pos_string,'rand')>0) then 
+            call random_number(rand)
+            cone = pos_string(index(pos_string, '[')+1:index(pos_string,':')-1)
+            call parse_pos(i, cone, rone)
+            ctwo = pos_string(index(pos_string, ':')+1:index(pos_string,']')-1)
+            call parse_pos(i, ctwo, rtwo)
+            pos = (rtwo - rone)*rand + rone            
+
+        else if ((index(pos_string,'-') > 0).and.(index(pos_string,'inf')>0)) then 
+            !Now extract the number we are reducing from infinity
+            if(index(pos_string,'inf') < index(pos_string,'-')) then 
+                read(pos_string(index(pos_string,'-')+1:), *, iostat=iospara) pos
+            else
+                read(pos_string(1:index(pos_string,'-')-1), *, iostat=iospara) pos
+            end if
+            pos = box_bd(2*i) - pos
+
+        else if ((index(pos_string,'+') > 0).and.(index(pos_string,'inf')>0)) then 
+            !Now extract the number we are reducing from infinity
+           if(index(pos_string,'inf') < index(pos_string,'+')) then 
+                read(pos_string(index(pos_string,'+')+1:), *, iostat=iospara) pos
+            else
+                read(pos_string(1:index(pos_string,'+')-1), *, iostat=iospara) pos
+            end if
+            pos = box_bd(2*i-1) + pos
+
+        else if ((index(pos_string,'*') > 0).and.(index(pos_string,'inf')>0)) then 
+            !Now extract the number we are reducing from infinity
+           if(index(pos_string,'inf') < index(pos_string,'*')) then 
+                read(pos_string(index(pos_string,'*')+1:), *, iostat=iospara) pos
+            else
+                read(pos_string(1:index(pos_string,'*')-1), *, iostat=iospara) pos
+            end if
+            pos = (box_bd(2*i)-box_bd(2*i-1))*pos + box_bd(2*i-1)
+
+        else
+            read(pos_string, *, iostat=iospara) pos
+
+        end if
+
+        if (iospara > 0) then 
+            print *, "Error reading position argument ", trim(adjustl(pos_string)), ". Please reformat and try again."
+        end if
+    end subroutine parse_pos
+
+    subroutine update_box_mat
+        !This subroutine updates the box matrix 
+        integer :: i
+        
+        box_mat = 0.0_wp
+        do i = 1, 3
+            box_mat(i,i) = box_length(i)
+        end do
+
+        return
+    end subroutine update_box_mat
+end module box

src/cg.f90

@@ -0,0 +1,560 @@
+module cg
+
+    use parameters
+    use comms
+    use elements 
+    use forces  
+    use time
+    use atom_types
+    use neighbors
+    use potential
+    use integration
+    use min_arrays
+    
+    implicit none
+
+    integer :: neval, nlimit
+    real(kind=wp), private, save :: alpha_max, alpha_reduce, backtrack_slope, quadratic_tol, emach, eps_quad, dmax, gg
+
+
+    public 
+    contains
+
+    subroutine cg_defaults
+        alpha_max = 1.0_wp
+        alpha_reduce = 0.25_wp
+        backtrack_slope = 0.4_wp
+        quadratic_tol = 0.1_wp
+        emach = 1.0d-8
+        eps_quad = 1.0d-28
+        dmax = 0.1
+        nlimit = min(huge(1),atom_num+node_num)
+    end subroutine cg_defaults
+
+    subroutine cg_init
+        integer :: ia, ibasis, ip, ie, inod
+        real(kind = wp) :: ggme 
+
+        !Initialize cg variables
+        call alloc_min_arrays
+        if(atom_num > 0) then 
+            hatom = force_atom(:,1:atom_num_l)
+            gatom = hatom
+        end if
+        if(ele_num > 0) then 
+            hnode = force_eq(:,:,1:node_num_l)
+            gnode = hnode
+        end if
+        
+        !Initialize number of evaluations to 0
+        neval = 0
+
+        !Initialize force norm_squared
+        ggme = 0
+        do ia = 1, atom_num_l
+            ggme = ggme + force_atom(1, ia)*force_atom(1,ia) + force_atom(2,ia)*force_atom(2,ia) &
+                        + force_atom(3,ia)*force_atom(3,ia)
+        end do
+        do ie = 1, ele_num_l
+            if(who_has_ele(ie)) then 
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod,ie)
+                    do ibasis = 1, basis_num(node_cg(ip))
+                        ggme = ggme + force_eq(1, ibasis,ip)*force_eq(1,ibasis,ip) &
+                                    + force_eq(2,ibasis,ip)*force_eq(2,ibasis,ip) & 
+                                    + force_eq(3,ibasis,ip)*force_eq(3,ibasis,ip)
+                    end do
+                end do
+            end if
+        end do
+       
+        call mpi_allreduce(ggme, gg, 1, mpi_wp, mpi_sum, world, ierr)
+    end subroutine cg_init
+
+    subroutine cg_clean
+        if(atom_num > 0) deallocate(hatom, gatom, rzeroatom)
+        if(ele_num > 0) deallocate(hnode, gnode, rzeronode)
+    end subroutine cg_clean
+
+    subroutine reset_cg_dir
+        !This simple subroutine just resets the cg search direction
+        if(atom_num > 0) then 
+            hatom = force_atom(:,1:atom_num_l)
+            gatom = hatom
+        end if
+        if(ele_num > 0) then 
+            hnode = force_eq(:,:,1:node_num_l)
+            gnode = hnode
+        end if
+    end subroutine reset_cg_dir
+
+    subroutine resize_min_array
+        !This subroutine resizes the min arrays if needed
+        real(kind=wp), allocatable :: gatom_array(:,:), hatom_array(:,:), gnode_array(:,:,:), hnode_array(:,:,:)
+        if (atom_num > 0) then 
+            allocate(gatom_array(3, atom_num_l), hatom_array(3, atom_num_l))
+            gatom_array=0.0_wp
+            call move_alloc(gatom_array, gatom)
+            hatom_array=0.0_wp
+            call move_alloc(hatom_array, hatom)
+
+            hatom = force_atom(:,1:atom_num_l)
+            gatom = hatom
+        end if
+
+        if (ele_num > 0) then 
+            allocate(gnode_array(3, max_basisnum, node_num_l), hnode_array(3, max_basisnum, node_num_l))
+            gnode_array=0.0_wp
+            call move_alloc(gnode_array, gnode)
+            hnode_array=0.0_wp
+            call move_alloc(hnode_array, hnode)
+
+            hnode = force_eq(:,:,1:node_num_l)
+            gnode = hnode
+        end if
+
+    end subroutine resize_min_array
+
+
+    subroutine cg_iterate(code)
+        integer, intent(out) :: code
+
+        integer :: ie, inod, ibasis, ip, ia
+        real(kind= wp) :: beta, dotme(2), dotall(2), fdotf, eprevious
+
+        !Line minimization along direction h from current position
+        eprevious = compute_pe(1)
+        call linesearch_backtrack(code)
+
+        if(code > 0) return
+
+        !Calculate force dot products
+        dotme(:) = 0
+        do ia = 1, atom_num_l
+            dotme(1) = dotme(1) + force_atom(1, ia)*force_atom(1,ia) + force_atom(2,ia)*force_atom(2,ia) &
+                                + force_atom(3,ia)*force_atom(3,ia)
+
+            dotme(2) = dotme(2) + force_atom(1, ia)*gatom(1,ia) + force_atom(2,ia)*gatom(2,ia) &
+                                + force_atom(3,ia)*gatom(3,ia)
+        end do
+        do ie = 1, ele_num_l
+            if(who_has_ele(ie)) then 
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(node_cg(ip))
+                        dotme(1) = dotme(1) + force_eq(1, ibasis,ip)*force_eq(1,ibasis,ip) &
+                                            + force_eq(2,ibasis,ip)*force_eq(2,ibasis,ip) &
+                                            + force_eq(3,ibasis,ip)*force_eq(3,ibasis,ip)
+
+                        dotme(2) = dotme(2) + force_eq(1, ibasis,ip)*gnode(1,ibasis,ip) &
+                                            + force_eq(2,ibasis,ip)*gnode(2,ibasis,ip) &
+                                            + force_eq(3,ibasis,ip)*gnode(3,ibasis,ip)
+                    end do
+                end do
+            end if
+        end do       
+        call mpi_allreduce(dotme, dotall, 2, mpi_wp, mpi_sum, world, ierr)
+        fdotf = dotall(1)
+
+        ! update new search direction h from new f = -Grad(x) and old g
+        ! this is Polak-Ribieri formulation
+        ! beta = dotall[0]/gg would be Fletcher-Reeves
+        ! reinitialize CG every ndof iterations by setting beta = 0.0
+        beta = max(0.0_wp,(dotall(1)-dotall(2))/gg)
+        if( mod((iter+1),nlimit) == 0) beta = 0.0_wp
+        gg = dotall(1)
+
+        !Update g and h
+        do ia = 1, atom_num_l
+            gatom(:,ia) = force_atom(:,ia)
+            hatom(:,ia) = gatom(:, ia) + beta*hatom(:,ia)
+        end do
+        do ip = 1, node_num_l
+            do ibasis = 1, basis_num(node_cg(ip))
+                gnode(:,ibasis,ip) = force_eq(:,ibasis,ip)
+                hnode(:,ibasis,ip) = gnode(:, ibasis,ip) + beta*hnode(:,ibasis,ip)
+            end do
+        end do
+
+        !Reinitialize CG if new search direction is not downhill
+        dotme(1) = 0.0_wp
+        do ia = 1, atom_num_l
+            dotme(1) = dotme(1) + gatom(1,ia)*hatom(1,ia) + gatom(2,ia)*hatom(2,ia) + gatom(3,ia)*hatom(3,ia)
+        end do
+        do ie = 1, ele_num_l
+            if(who_has_ele(ie)) then 
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                        dotme(1) = dotme(1) + gnode(1,ibasis,ip)*hnode(1,ibasis,ip) + gnode(2,ibasis,ip)*hnode(2,ibasis,ip) &
+                                        + gnode(3,ibasis,ip)*hnode(3,ibasis,ip)
+                    end do
+                end do
+            end if
+        end do
+        call mpi_allreduce(dotme(1), dotall(1), 1, mpi_wp, mpi_sum, world, ierr)
+        if(dotall(1) <= 0.0) then 
+            if(atom_num > 0) hatom=gatom
+            if(ele_num > 0) hnode=gnode
+        end if
+        
+    end subroutine cg_iterate
+
+    subroutine linesearch_backtrack(code)
+        !linemin: backtracking line search (Proc 3.1, p 41 in Nocedal and Wright)
+        !uses no gradient info, but should be very robust
+        !start at maxdist, backtrack until energy decrease is sufficient
+        integer, intent(out) :: code
+
+        integer ::  ia, ip, ibasis, inod, ie
+        real(kind=wp) :: fdothall, fdothme, hme, hmaxall, de_ideal, de, ecurrent, eoriginal, alpha
+
+        !First calculate fdothall which is the projection of search dir along downhill gradient
+        fdothme = 0.0_wp
+        do ia = 1, atom_num_l
+            fdothme = fdothme + force_atom(1,ia)*hatom(1,ia) + force_atom(2,ia)*hatom(2,ia) + force_atom(3, ia)*hatom(3,ia)
+        end do
+        do ie = 1, ele_num_l
+            if(who_has_ele(ie)) then 
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                        fdothme = fdothme + force_eq(1,ibasis,ip)*hnode(1,ibasis,ip) + force_eq(2,ibasis,ip)*hnode(2,ibasis,ip) &
+                                          + force_eq(3,ibasis,ip)*hnode(3,ibasis,ip)
+                    end do
+                end do
+            end if
+        end do
+        call mpi_allreduce(fdothme, fdothall, 1, mpi_wp, mpi_sum, world, ierr)
+        !If search direction isn't downhill return with error
+        if(fdothall <= 0.0_wp) then 
+            code = 4
+            return
+        end if
+
+        ! set alpha so no dof is changed by more than max allowed amount
+        ! for atom coords, max amount = dmax
+        ! for extra per-atom dof, max amount = extra_max[]
+        ! for extra global dof, max amount is set by fix
+        ! also insure alpha <= ALPHA_MAX
+        ! else will have to backtrack from huge value when forces are tiny
+        ! if all search dir components are already 0.0, exit with error
+        hme = 0.0_wp
+        do ia = 1, atom_num_l
+            hme = max(hme, hatom(1,ia), hatom(2,ia), hatom(3,ia))
+        end do
+        do ie = 1, ele_num_l
+            if(who_has_ele(ie)) then 
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(node_cg(ip))
+                        hme = max(hme, hnode(1,ibasis,ip), hnode(2,ibasis,ip), hnode(3,ibasis,ip))
+                    end do
+                end do
+            end if
+        end do       
+        call mpi_allreduce(hme, hmaxall, 1, mpi_wp, mpi_max, world, ierr)
+        if(is_equal(hmaxall, 0.0_wp)) then 
+            code = 5
+            return
+        end if
+        !Set starting alpha
+        alpha = min(alpha_max, dmax/hmaxall)
+
+        !Save initial coordinates
+        if(atom_num_l > 0) rzeroatom(:,1:atom_num_l) = r_atom(:,1:atom_num_l)
+        if(node_num_l > 0) rzeronode(:,:,1:node_num_l) = r(:,:,1:node_num_l)
+        eoriginal = compute_pe(1)
+
+        !Backtrack until decrease in energy is sufficient
+        do while(.true.)
+            !Step forward along h
+            if (alpha > 0.0_wp) then 
+                do ia = 1, atom_num_l
+                    r_atom(:,ia) = rzeroatom(:,ia) + alpha*hatom(:,ia) 
+                end do
+
+                do ip = 1, node_num_l
+                    do ibasis = 1, basis_num(node_cg(ip))
+                        r(:,ibasis,ip) = rzeronode(:,ibasis, ip) + alpha*hnode(:,ibasis, ip)
+                    end do
+                end do
+                neval = neval + 1
+                call update_neighbor(iter, .true.)
+                call update_force
+                ecurrent=compute_pe(1)
+
+            end if
+
+            !Quit with success if energy change is better than ideal
+            de_ideal = -backtrack_slope*alpha*fdothall
+            de = ecurrent-eoriginal
+            if(de <= de_ideal) then 
+                code = 0
+                return
+            end if
+
+            !Reduce alpha
+            alpha = alpha * alpha_reduce
+            !Backtracked too much, reset to starting point
+            ! if de is positive exit with error'
+            ! if de is negative than we have reached energy tol
+            if((alpha <= lim_zero) .or. (de_ideal >= EMACH)) then 
+                if(atom_num_l > 0) r_atom(:, 1:atom_num_l) = rzeroatom(:, 1:atom_num_l)
+                if(ele_num_l > 0) r(:,:,1:node_num_l) = rzeronode(:,:,1:node_num_l)
+                call update_neighbor(iter, .true.)
+                call update_force
+                if(de < 0.0) then 
+                    code = 1
+                    return
+                else
+                    code = 6 
+                    return
+                end if
+            end if
+        end do
+    end subroutine linesearch_backtrack
+
+
+
+    subroutine linesearch_quadratic(code)
+        !----------------------------------------------------------------------
+        ! linemin: quadratic line search (adapted from Dennis and Schnabel)
+        ! The objective function is approximated by a quadratic
+        ! function in alpha, for sufficiently small alpha.
+        ! This idea is the same as that used in the well-known secant
+        ! method. However, since the change in the objective function
+        ! (difference of two finite numbers) is not known as accurately
+        ! as the gradient (which is close to zero), all the expressions
+        ! are written in terms of gradients. In this way, we can converge
+        ! the LAMMPS forces much closer to zero.
+        !
+        ! We know E,Eprev,fh,fhprev. The Taylor series about alpha_prev
+        ! truncated at the quadratic term is:
+        !
+        !     E = Eprev - del_alpha*fhprev + (1/2)del_alpha^2*Hprev
+        !
+        ! and
+        !
+        !     fh = fhprev - del_alpha*Hprev
+        !
+        ! where del_alpha = alpha-alpha_prev
+        !
+        ! We solve these two equations for Hprev and E=Esolve, giving:
+        !
+        !     Esolve = Eprev - del_alpha*(f+fprev)/2
+        !
+        ! We define relerr to be:
+        !
+        !      relerr = |(Esolve-E)/Eprev|
+        !             = |1.0 - (0.5*del_alpha*(f+fprev)+E)/Eprev|
+        !
+        ! If this is accurate to within a reasonable tolerance, then
+        ! we go ahead and use a secant step to fh = 0:
+        !
+        !      alpha0 = alpha - (alpha-alphaprev)*fh/delfh;
+        !
+        !------------------------------------------------------------------------- 
+        integer, intent(out) :: code
+
+        integer ::  ia, ip, ibasis, ie, inod
+        real(kind=wp) :: fdothall, fdothme, hme, hmaxall, de_ideal, de, ecurrent, eoriginal, alpha, alphaprev, fhprev, &
+                         engprev, dotme(2), dotall(2), fh, ff, delfh, relerr, alpha0, alphamax
+
+        !First calculate fdothall which is the projection of search dir along downhill gradient
+        fdothme = 0.0_wp
+        do ia = 1, atom_num_l
+            fdothme = fdothme + force_atom(1,ia)*hatom(1,ia) + force_atom(2,ia)*hatom(2,ia) + force_atom(3, ia)*hatom(3,ia)
+        end do
+        do ie = 1, ele_num_l
+            if(who_has_ele(ie)) then 
+                do inod = 1, ng_node(etype(ie)) 
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                        fdothme = fdothme + force_eq(1,ibasis,ip)*hnode(1,ibasis,ip) &
+                                          + force_eq(2,ibasis,ip)*hnode(2,ibasis,ip) &
+                                          + force_eq(3,ibasis,ip)*hnode(3,ibasis,ip)
+                    end do
+                end do
+            end if
+        end do
+        call mpi_allreduce(fdothme, fdothall, 1, mpi_wp, mpi_sum, world, ierr)
+        !If search direction isn't downhill return with error
+        if(fdothall <= 0.0_wp) then 
+            code = 4
+            return
+        end if
+
+
+        ! set alpha so no dof is changed by more than max allowed amount
+        ! for atom coords, max amount = dmax
+        ! for extra per-atom dof, max amount = extra_max[]
+        ! for extra global dof, max amount is set by fix
+        ! also insure alpha <= ALPHA_MAX
+        ! else will have to backtrack from huge value when forces are tiny
+        ! if all search dir components are already 0.0, exit with error
+        hme = 0.0_wp
+        do ia = 1, atom_num_l
+            hme = max(hme, hatom(1,ia), hatom(2,ia), hatom(3,ia))
+        end do
+        do ie = 1, ele_num_l
+            if(who_has_ele(ie)) then 
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                        hme = max(hme, hnode(1,ibasis,ip), hnode(2,ibasis,ip), hnode(3,ibasis,ip))
+                    end do
+                end do
+            end if
+        end do       
+        call mpi_allreduce(hme, hmaxall, 1, mpi_wp, mpi_max, world, ierr)
+        if(is_equal(hmaxall, 0.0_wp)) then 
+            code = 5
+            return
+        end if
+        !Get alphamax
+        alphamax = min(alpha_max, dmax/hmaxall)
+
+        !Save initial coordinates
+        if(atom_num_l > 0) rzeroatom(:,1:atom_num_l) = r_atom(:,1:atom_num_l)
+        if(node_num_l > 0) rzeronode(:,:,1:node_num_l) = r(:,:,1:node_num_l)
+        eoriginal = compute_pe(1)
+        alpha = alphamax
+        fhprev = fdothall
+        engprev = eoriginal
+        alphaprev = 0.0_wp
+
+        !Backtrack until decrease in energy is sufficient
+        do while(.true.)
+            
+            
+            !Step forward along h
+            if (alpha > 0.0_wp) then 
+                do ia = 1, atom_num_l
+                    r_atom(:,ia) = rzeroatom(:,ia) + alpha*hatom(:,ia) 
+                end do
+
+                do ip = 1, node_num_l
+                    do ibasis = 1, basis_num(node_cg(ip))
+                        r(:,ibasis,ip) = rzeronode(:,ibasis, ip) + alpha*hnode(:,ibasis, ip)
+                    end do
+                end do
+                neval = neval + 1
+                call update_neighbor(iter, .true.)
+                call update_force
+                ecurrent=compute_pe(1)
+            end if
+
+            ! Compute new fh, alpha, delfh
+            dotme(:) = 0
+            do ia = 1, atom_num_l
+                dotme(1) = dotme(1) + force_atom(1, ia)*force_atom(1,ia) + force_atom(2,ia)*force_atom(2,ia) &
+                                    + force_atom(3,ia)*force_atom(3,ia)
+
+                dotme(2) = dotme(2) + force_atom(1, ia)*hatom(1,ia) + force_atom(2,ia)*hatom(2,ia) &
+                                    + force_atom(3,ia)*hatom(3,ia)
+            end do
+            do ie = 1, ele_num_l
+                if(who_has_ele(ie)) then 
+                    do inod = 1, ng_node(etype(ie))
+                        ip = cg_node(inod, ie)
+                        do ibasis = 1, basis_num(ie)
+                            dotme(1) = dotme(1) + force_eq(1, ibasis,ip)*force_eq(1,ibasis,ip) &
+                                                + force_eq(2,ibasis,ip)*force_eq(2,ibasis,ip) &
+                                                + force_eq(3,ibasis,ip)*force_eq(3,ibasis,ip)
+
+                            dotme(2) = dotme(2) + force_eq(1, ibasis,ip)*hnode(1,ibasis,ip) &
+                                                + force_eq(2,ibasis,ip)*hnode(2,ibasis,ip) &
+                                                + force_eq(3,ibasis,ip)*hnode(3,ibasis,ip)
+                        end do
+                    end do
+                end if
+            end do       
+            call mpi_allreduce(dotme, dotall, 2, mpi_wp, mpi_sum, world, ierr)
+
+            ff = dotall(1)
+            fh = dotall(2)
+            delfh = fh-fhprev
+
+            !If fh or delfh is epsilon, reset to starting point and exit with error
+            if((abs(fh) < eps_quad) .or. (abs(delfh) < eps_quad)) then 
+                if(atom_num_l > 0) r_atom(:, 1:atom_num_l) = rzeroatom(:, 1:atom_num_l)
+                if(node_num_l > 0) r(:,:,1:node_num_l) = rzeronode(:, :, 1:node_num_l)
+                call update_neighbor(iter, .true.)
+                call update_force
+
+                code = 11
+                return
+            end if
+
+            !!Check if ready for quadratic projection, quivalent to secant method
+            !alpha0 = projected alpha
+            relerr = abs(1.0_wp-(0.5_wp*(alpha-alphaprev)*(fh+fhprev)+ecurrent)/engprev)
+            alpha0 = alpha - (alpha-alphaprev)*fh/delfh
+            if((relerr <= quadratic_tol).and.(alpha0 > 0.0).and.(alpha0<alphamax)) then 
+
+                !Step forward along h
+                do ia = 1, atom_num_l
+                    r_atom(:,ia) = rzeroatom(:,ia) + alpha0*hatom(:,ia) 
+                end do
+
+                do ip = 1, node_num_l
+                    do ibasis = 1, basis_num(node_cg(ip))
+                        r(:,ibasis,ip) = rzeronode(:,ibasis, ip) + alpha0*hnode(:,ibasis, ip)
+                    end do
+                end do
+                neval = neval + 1
+                call update_neighbor(iter, .true.)
+                call update_force
+                ecurrent=compute_pe(1)
+                if((ecurrent-eoriginal) < emach) then 
+                    code = 0
+                    return 
+                end if
+            end if
+
+            !Quit with success if energy change is better than ideal
+            de_ideal = -backtrack_slope*alpha*fdothall
+            de = ecurrent-eoriginal
+            if(de <= de_ideal) then 
+                code = 0
+                return
+            end if
+
+            !Save previous state
+            fhprev = fh
+            engprev = ecurrent
+            alphaprev = alpha
+
+            !Reduce alpha
+            alpha = alpha * alpha_reduce
+
+            !Backtracked too much, reset to starting point
+            ! if de is positive exit with error'
+            ! if de is negative than we have reached energy tol
+            if((alpha <= 0.0) .or. (de_ideal >= EMACH)) then 
+                if(atom_num_l > 0) r_atom(:, 1:atom_num_l) = rzeroatom
+                if(ele_num_l > 0) r(:,:,1:node_num_l) = rzeronode
+
+                call update_neighbor(iter, .true.)
+                call update_force
+
+                if(de < 0.0) then 
+                    code = 1
+                    return
+                else
+                    code = 6 
+                    return
+                end if
+            end if
+        end do
+    end subroutine linesearch_quadratic
+
+    pure function get_cg_neval()
+        integer :: get_cg_neval
+
+        get_cg_neval = neval
+        return
+    end function get_cg_neval
+
+end module cg

src/compute.f90

@@ -0,0 +1,255 @@
+module compute
+
+    !This module contains all of the compute subroutines
+    use mpi
+    use parameters
+    use comms
+    use atom_types
+    use forces
+    use elements
+    use group
+    use box
+
+    implicit none 
+
+    public 
+    contains
+
+    function compute_pe(group, arg1)
+        !This function returns the summed energy for all atoms and elements, for elements it adds the contribution for all 
+        !interpolated atoms
+        integer, intent(in) :: group
+        logical, intent(in), optional :: arg1 
+        real(kind=wp) :: compute_pe
+        integer :: ia, ie, ip, ibasis, inod
+        real(kind=wp) :: pe, peall
+        logical :: weigh_ele
+       
+        if(present(arg1)) then 
+            weigh_ele=arg1
+        else 
+            weigh_ele=.true.
+        end if
+
+        pe = 0
+        do ia = 1, atom_num_l
+            if (btest(a_mask(ia), group)) then 
+                pe = pe + energy_atom(ia)
+            end if
+        end do 
+
+        if(weigh_ele) then 
+            do ie = 1, ele_num_l
+                if(btest(e_mask(ie), group).and.who_has_ele(ie)) then 
+                    do inod =1, ng_node(etype(ie))
+                        ip = cg_node(inod, ie)
+                        do ibasis=1, basis_num(ie)
+                            pe = pe + energy_eq(ibasis, ip)*mass_mat_coeff(size_ele(ie), etype(ie))
+                        end do
+                    end do
+                end if
+            end do
+        else
+            do ie = 1, ele_num_l
+                if(btest(e_mask(ie), group).and.who_has_ele(ie)) then 
+                    do inod =1, ng_node(etype(ie))
+                        ip = cg_node(inod, ie)
+                        do ibasis=1, basis_num(ie)
+                            pe = pe + energy_eq(ibasis, ip)
+                        end do
+                    end do
+                end if
+            end do
+        end if
+        
+        call mpi_allreduce(pe, peall, 1, mpi_wp, mpi_sum, world, ierr)
+        compute_pe = peall
+        return
+    end function compute_pe
+   
+    function compute_fnorm(group)
+        !This function returns the global norm of the force vector for all atoms and elements, 
+        !for elements it adds the contribution for all interpolated atoms
+        integer, intent(in) :: group
+        real(kind=wp) :: compute_fnorm
+        integer :: ia, ie, ip, ibasis, inod
+        real(kind=wp) ::  fme, f(3), fall
+        
+        fme = 0.0_wp
+        do ia = 1, atom_num_l
+            if (btest(a_mask(ia), group)) then 
+                fme =  fme + force_atom(1,ia)*force_atom(1,ia) + force_atom(2, ia)*force_atom(2,ia) &
+                      +force_atom(3,ia)*force_atom(3,ia)                                  
+            end if
+        end do 
+
+        do ie = 1, ele_num_l
+            if(btest(e_mask(ie), group).and.who_has_ele(ie)) then 
+                do inod =1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis=1, basis_num(ie)
+                        f = force_eq(:,ibasis, ip)
+                        fme = fme + (f(1)*f(1) + f(2)*f(2) + f(3)*f(3))
+                    end do
+                end do
+            end if
+        end do
+        
+        call mpi_allreduce(fme, fall, 1, mpi_wp, mpi_sum, world, ierr)
+        compute_fnorm = sqrt(fall)
+        return
+    end function compute_fnorm
+
+    function compute_avgvel(group)
+        !This function returns the average velocity of the system
+        integer, intent(in) :: group
+        real(kind=wp) :: compute_avgvel(3)
+        integer :: ia, ie, ip, ibasis, inod
+        real(kind=wp) :: vme(3), vall(3)
+
+        vme=0.0_wp
+        do ia =1, atom_num_l
+            if (btest(a_mask(ia), group)) then 
+                vme = vme + vel_atom(:,ia)
+            end if
+        end do
+
+        do ie = 1, ele_num_l
+            if(btest(e_mask(ie), group).and.who_has_ele(ie)) then 
+                do inod =1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis=1, basis_num(ie)
+                        vme = vme + vel(:, ibasis,ip)
+                    end do
+                end do
+            end if
+        end do
+
+        call mpi_allreduce(vme(:), vall(:), 3, mpi_wp, mpi_sum, world, ierr)
+
+        compute_avgvel = vall/(group_counts(1,group)+group_counts(3,group))
+
+        return
+    end function compute_avgvel
+
+    function compute_ke(group, in_avg_vel)
+        !This subroutine calculates the kinetic energy of the group
+        integer, intent(in) :: group
+        real(kind=wp), intent(in), optional  :: in_avg_vel(3)
+
+        real(kind=wp) :: compute_ke(2)
+        integer :: ia, j, ie, ip, ibasis, inod
+        real(kind=wp) :: kme(2), avgvel(3), kall(2)
+
+
+        if(present(in_avg_vel)) then 
+            avgvel = in_avg_vel
+        else
+            avgvel = compute_avgvel(group)
+        end if
+        
+        kme = 0.0_wp
+        do ia = 1, atom_num_l
+            if (btest(a_mask(ia), group)) then 
+                do j = 1,3
+                    kme(1) = kme(1) + 0.5_wp*masses(type_atom(ia))*const_motion*(vel_atom(j,ia) - avgvel(j))**2.0_wp
+                end do
+            end if
+        end do 
+
+        do ie = 1, ele_num_l
+            if(btest(e_mask(ie), group).and.who_has_ele(ie)) then 
+                do inod =1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis=1, basis_num(ie)
+                        do j = 1,3
+                            kme(2) = kme(2) + mass_mat_coeff(size_ele(ie), etype(ie))*0.5_wp*masses(basis_type(ibasis,ie)) &
+                                              *const_motion*(vel(j,ibasis,ip) - avgvel(j))**2.0_wp
+                        end do
+                    end do 
+                end do
+            end if
+        end do
+
+        call mpi_allreduce(kme, kall, 2, mpi_wp, mpi_sum, world, ierr)
+
+        compute_ke = kall
+        return
+    end function compute_ke
+
+    function compute_temp(group, in_ke)
+        !This function calculates the temperature for the current model
+        integer, intent(in) :: group
+        real(kind=wp), intent(in), optional :: in_ke(2)
+
+        real(kind=wp) ::  compute_temp(3)
+        real(kind=wp) :: ke(2)
+
+        if(present(in_ke)) then 
+            ke = in_ke
+        else
+            ke = compute_ke(group)
+        end if
+
+        compute_temp = 0
+
+        compute_temp(1) = (2.0_wp*(ke(1)+ke(2)))/(3*(group_counts(1,group)+group_counts(4,group))*boltzmann)
+        if (atom_num > 0) compute_temp(2) = (2.0_wp*(ke(1)))/(3*(group_counts(1,group))*boltzmann)
+        if (ele_num > 0) compute_temp(3) = (2.0_wp*(ke(2)))/(3*group_counts(4,group)*boltzmann)
+        return
+    end function compute_temp
+
+    function compute_box_press()
+        !This calculates the box pressure. Can only be done on the full box which is why it takes no inputs
+        real(kind=wp) :: compute_box_press(3,3)
+            
+        integer :: ia, ibasis, ip, inod, ie, i, j, k
+        real(kind=wp) :: vir_buffme(9), vir_buffall(9), box_volume
+
+        vir_buffme(:) = 0.0_wp
+        !Sum virial stress in the atom region
+        if(atom_num_l > 0) then 
+            do ia = 1, atom_num_l
+                k = 1
+                do j = 1,3
+                    do i = 1,3
+                        vir_buffme(k) = vir_buffme(k) - virial_atom(i,j,ia)
+                        k = k+1
+                    end do
+                end do
+            end do
+        end if
+
+        if(ele_num_l > 0) then 
+            do ie = 1, ele_num_l
+                if(who_has_ele(ie)) then 
+                    do inod = 1, ng_node(etype(ie))
+                        ip = cg_node(inod,ie)
+                        do ibasis = 1, basis_num(ie)
+                            k = 1
+                            do j = 1,3
+                                do i = 1,3
+                                    vir_buffme(k) = vir_buffme(k) - virial_eq(i,j,ibasis,ip)*mass_mat_coeff(size_ele(ie), itype(ie))
+                                    k = k + 1
+                                end do
+                            end do
+                        end do
+                    end do  
+                end if
+            end do
+        end if
+
+        !Now sum the virial over all processors
+        call mpi_allreduce(vir_buffme, vir_buffall, 9, mpi_wp, mpi_sum, world, ierr)
+    
+        box_volume = box_length(1)*box_length(2)*box_length(3)
+        k = 1
+        do j = 1,3
+            do i = 1,3
+                compute_box_press(i,j) = nktv2p*vir_buffall(k)/box_volume
+            end do
+        end do
+        return
+    end function compute_box_press
+
+end module compute

src/debug.f90

@@ -0,0 +1,119 @@
+module debug
+    !This module is used to run various debugging commands which can be used during simulations for additional correctness checks
+    use parameters
+    use forces
+    use elements
+    use str
+
+    implicit none
+
+    logical, private :: check_ele_flag
+    logical :: dflag
+    public 
+    contains
+    
+
+    subroutine parse_debug(line)
+        !This subroutine parses the debug command
+        character(len=*), intent(in) :: line 
+        integer :: i, j, iospara
+        character(len=read_len) :: tmptxt, commands(10), msg
+
+        j = tok_count(line)-1
+        dflag=.true.
+        
+        !Initialize flags
+        check_ele_flag=.false.
+
+        read(line, *, iostat=iospara, iomsg = msg) tmptxt, (commands(i), i =1, j)
+
+        !Now set the debug flags
+        do i = 1, j
+            select case(commands(i))
+            case('check_ele')
+                check_ele_flag= .true.
+            end select
+        end do
+
+    end subroutine parse_debug
+
+    subroutine run_debug
+        !This is the main running function which calls all of the sub debug subroutines
+        if(check_ele_flag) call check_ele
+    end subroutine run_debug
+
+    subroutine check_ele
+        !This code goes over every single element and compares the positions among all elements. 
+        !This code is very slow
+        integer :: ie, ke, inod, i, j, k
+        real(kind=wp) :: rbuff(3*ng_max_node), rbuffall(3*ng_max_node*pro_num)
+        real(kind=wp) :: velbuff(3*ng_max_node), velbuffall(3*ng_max_node*pro_num)
+        logical :: have_ele, have_ele_all(pro_num)
+        character(len=read_len) :: msg
+
+        rbuff=0.0_wp
+        velbuff=0.0_wp
+        !Loop over all global tags
+        do ke = 1, ele_num
+            !Loop over all local tags to find the matching element
+            do ie = 1, ele_num_l
+                if(ele_glob_id(ie) == ke) exit
+            end do
+
+            if (ie > ele_num_l) then 
+                have_ele=.false.
+                rbuff = 0.0_wp
+            else
+                have_ele=.true.
+                do inod =1, ng_node(etype(ie))
+                    do i = 1, 3
+                        rbuff(3*(inod-1)+i) = r(i, 1, cg_node(inod,ie))
+                        if(need_vel) velbuff(3*(inod-1)+i) = vel(i, 1, cg_node(inod,ie))
+                    end do
+                end do
+            end if
+
+            rbuffall=0.0_wp
+            velbuffall=0.0_wp
+            !Now communicate this element 
+            call mpi_gather(have_ele, 1, mpi_logical, have_ele_all, 1, mpi_logical, root, world, ierr)
+            call mpi_gather(rbuff, 3*ng_max_node, mpi_wp, rbuffall, 3*ng_max_node, mpi_wp, root, world, ierr)
+            if(need_vel) call mpi_gather(velbuff, 3*ng_max_node, mpi_wp, velbuffall, 3*ng_max_node, mpi_wp, root, world, ierr)
+
+            !Now check the elements
+            if(rank==root) then 
+                if(count(have_ele_all) > 1) then 
+                    do i = 1, pro_num
+                        if(have_ele_all(i)) then 
+                            do j=1, pro_num
+                                if((j>i) .and. (have_ele_all(j))) then 
+                                    do k = 1, 3*ng_max_node
+                                        if(.not.is_equal(rbuffall((i-1)*ng_max_node*3 + k), &
+                                                         rbuffall((j-1)*ng_max_node*3 + k))) then
+                                            write(msg, *) "Element with global tag ", ke, " does not have matching nodal ", &
+                                                          "positions for processors ", i-1, " and ", j-1, " with values ", &
+                                                          rbuffall((i-1)*ng_max_node*3 + k), " and ", &
+                                                          rbuffall((j-1)*ng_max_node*3 + k)
+                                            call misc_error(msg)
+
+                                        end if
+                                        if(need_vel) then 
+                                            if(.not.is_equal(velbuffall((i-1)*ng_max_node*3 + k), &
+                                                             velbuffall((j-1)*ng_max_node*3 + k))) then
+                                                write(msg, *) "Element with global tag ", ke, " does not have matching nodal ", &
+                                                              "velocities for processors ", i-1, " and ", j-1, " with values ", &
+                                                              velbuffall((i-1)*ng_max_node*3 + k), " and ", &
+                                                              velbuffall((j-1)*ng_max_node*3 + k)
+                                                call misc_error(msg)
+                                            end if
+                                        end if
+                                    end do
+                                end if
+                            end do
+                        end if
+                    end do
+                end if
+            end if
+        end do
+    end subroutine check_ele
+end module debug

src/deform.f90

@@ -0,0 +1,176 @@
+module deform
+    !This module applies deformations to the box which is then applied to all of the atoms
+
+    use parameters
+    use box
+    use elements 
+    use neighbors
+    use time
+    use comms
+
+    implicit none
+    
+    integer :: deform_num
+    integer, private, parameter :: max_deform_num = 10
+    real(kind=wp),private :: rate(max_deform_num)
+    integer, private :: ddim(max_deform_num), nnevery(max_deform_num), exclude_gnum(max_deform_num)
+    
+    public 
+    contains
+
+    subroutine parse_deform(line)
+        !Parse the deform command
+        character(len=*), intent(in) :: line
+        character(len=read_len) :: tmptxt, deform_dim, msg, excludeg, args(20)
+        integer :: iospara, i, d, j, now_excludeg
+        real(kind = dp) :: strain, def
+        real(kind=dp), allocatable :: r_zero_atom(:, :), r_zero_node(:,:,:)
+        
+        
+        read(line, *, iostat = iospara, iomsg = msg) tmptxt, tmptxt
+        if(iospara > 0) call read_error(msg, iospara)
+        select case(tmptxt)
+        case('now')
+            now_excludeg=0
+            read(line, *, iostat= iospara, iomsg = msg) tmptxt, tmptxt, deform_dim, strain
+            if(iospara > 0) call read_error(msg, iospara)
+            j=tok_count(line)
+            if (j>4) then
+                read(line, *) args(1:j)
+                i=5
+                do while(i<=j)
+                    select case(args(i))
+                        case('exclude')
+                            i=i+1
+                            read(args(i), *) excludeg
+                            i=i+1
+                            now_excludeg = get_group_index(excludeg)
+                            allocate(r_zero_atom(3,atom_num_l), r_zero_node(3, max_basisnum, node_num_l))
+                            if(atom_num_l > 0) r_zero_atom = r_atom
+                            if(ele_num_l > 0) r_zero_node = r
+                            write(msg, *) "Excluding group ", trim(adjustl(excludeg)), ' from deform command' 
+                            call log_msg(msg)
+                        case default
+                            write(msg, *) "Keyword ", trim(adjustl(args(i))), " is not accepted in neighbor command"
+                            call command_error(msg)
+                    end select
+                end do
+            end if
+            !Now convert the dimension to an integer for use later
+            select case(deform_dim)
+            case('x','X')
+                d = 1
+            case('y','Y')
+                d = 2
+            case('z','Z')
+                d = 3
+            end select
+            !First we convert atoms and nodes to fractional coordinates if necessary
+            call x2frac
+
+            def = strain*orig_box_length(d)
+            box_bd(2*d-1) = box_bd(2*d-1) - 0.5_wp*def
+            box_bd(2*d) = box_bd(2*d) + 0.5_wp*def
+            box_length(d) = box_bd(2*d) - box_bd(2*d-1)
+            !Now update proc bds
+            do i = 1, 3
+                pro_length(i) = box_length(i) / num_pro(i)
+                pro_bd(2*i-1) = box_bd(2*i-1) + grid_coords(i) * pro_length(i)
+                pro_bd(2*i) = box_bd(2*i-1) + (grid_coords(i) + 1) * pro_length(i)
+            end do
+            call processor_bds        
+            !Convert back to real coordinates if we applied a deformation
+            call frac2x
+
+            if(now_excludeg > 0) then 
+                do i = 1, atom_num_l
+                    if(btest(a_mask(i),now_excludeg)) then 
+                        r_atom(:, i)=r_zero_atom(:,i)
+                    end if
+                end do
+                do i = 1, ele_num_l
+                    if(btest(e_mask(i), now_excludeg)) then 
+                        r(:,:,i) = r_zero_node(:,:,i) 
+                    end if
+                end do
+            end if
+
+            write(msg, *) "Increasing box bounds in ", trim(adjustl(deform_dim)), " by ", def
+            call log_msg(msg)
+
+            call update_neighbor(iter, .false.,.true.)
+
+        case default
+            deform_num=deform_num + 1
+            read(line, *, iostat= iospara, iomsg = msg)tmptxt, nnevery(deform_num), deform_dim, rate(deform_num)
+            if(iospara > 0) call read_error(msg, iospara)
+
+            !Now convert the dimension to an integer for use later
+            select case(deform_dim)
+            case('x','X')
+                ddim(deform_num) = 1
+            case('y','Y')
+                ddim(deform_num) = 2
+            case('z','Z')
+                ddim(deform_num) = 3
+            end select
+        end select
+
+        return
+
+    end subroutine parse_deform
+
+    subroutine deform_box
+        !This subroutine updates the box boundaries and then rescales the atomic positions
+        
+        integer :: i
+        real(kind=wp) :: def
+        logical :: convert 
+        character(len=1) :: def_dim(3)
+        character(len=read_len) :: msg
+
+        def_dim = ['x','y','z']
+
+
+        !First update the box length
+        !Now update the box boundaries
+        convert = .false.
+        do i = 1, deform_num
+
+            if(mod(iter, nnevery(i)) == 0) then 
+                !First c
+                if(.not.convert) then 
+                    !First we convert atoms and nodes to factional coordinates if necessary
+                    call x2frac
+                    convert = .true.
+                end if
+
+                def = time_step*rate(i)*orig_box_length(ddim(i))
+                box_bd(2*ddim(i)-1) = box_bd(2*ddim(i)-1) - 0.5_wp*def
+                box_bd(2*(ddim(i))) = box_bd(2*(ddim(i))) + 0.5_wp*def
+                box_length(ddim(i)) = box_bd(2*ddim(i)) - box_bd(2*ddim(i)-1)
+
+                write(msg, *) "Increasing box bounds in ", trim(adjustl(def_dim(ddim(1)))), " by ", def, " for deform ", i
+                call log_msg(msg)
+            end if
+        end do
+
+
+        !Now update proc bds
+        if(convert) then
+            do i = 1, 3
+                pro_length(i) = box_length(i) / num_pro(i)
+                pro_bd(2*i-1) = box_bd(2*i-1) + grid_coords(i) * pro_length(i)
+                pro_bd(2*i) = box_bd(2*i-1) + (grid_coords(i) + 1) * pro_length(i)
+            end do
+            call processor_bds        
+
+            !Convert back to real coordinates if we applied a deformation
+             call frac2x
+
+            call update_neighbor(iter, .false.,.true.)
+        end if
+        return
+    end subroutine deform_box
+
+end module deform

src/displace.f90

@@ -0,0 +1,140 @@
+module displace
+    !This module contains subroutines which apply displacements to atoms and elements
+    use forces
+    use parameters 
+    use elements
+    use group
+    use str
+    use time
+    use neighbors
+
+    implicit none 
+
+    public 
+    contains
+    subroutine displace_points(line)
+        !This subroutine parses the displace command
+        character(len = *), intent(in) :: line
+        character(len=read_len) :: tmptxt, g, txtvec(3)
+        integer :: iospara, i, ia, ip, ibasis, ie, gnum
+        real(kind=wp) :: disp(3) 
+
+        if((ele_num == 0).and.(atom_num == 0)) call misc_error("Model must be read in before calling displace command")
+
+        read(line, *, iostat=iospara) tmptxt, g, (txtvec(i), i = 1, 3)
+        if(iospara > 0) call read_error("Failure to read displace command", iospara)
+
+        !Get group number
+        gnum = get_group_index(g)
+        if(gnum == 0) then 
+            call misc_error("Group "//trim(adjustl(g))// " in displace command has not been defined. "// &
+                            "Please define group before use")
+        end if
+
+        !Read displacement vector
+        do i =1, 3
+            read(txtvec(i), *, iostat = iospara) disp(i)
+            if(iospara > 0) call read_error("Failure to read disp vector component "//trim(adjustl(txtvec(i))), iospara)
+        end do
+
+        !Now displace points
+        do ia = 1, atom_num_l
+            if(btest(a_mask(ia), gnum)) then 
+                r_atom(:,ia) = r_atom(:, ia) + disp
+            end if
+        end do
+        do ip = 1, node_num_l
+            ie = node_cg(ip)
+            if(btest(e_mask(ie), gnum)) then
+                do ibasis = 1, basis_num(ie)
+                    r(:, ibasis, ip) = r(:, ibasis, ip) + disp
+                end do
+            end if
+        end do
+
+        call update_neighbor(iter, .false., .true.)
+
+    end subroutine displace_points
+
+    subroutine ramp_displace(line)
+        !This subroutine parses the displace command
+        character(len = *), intent(in) :: line
+        character(len=read_len) :: tmptxt, g, txtvec(4), rdim, ddim
+        integer :: iospara,  ia, ip, ibasis, ie, gnum, j, k
+        real(kind=wp) :: rhi, rlo, disp, hi, lo, frac
+
+        if((ele_num == 0).and.(atom_num == 0)) call misc_error("Model must be read in before calling ramp command")
+
+        read(line, *, iostat=iospara) tmptxt, g, ddim, txtvec(1), txtvec(2), rdim, rlo, rhi
+        if(iospara > 0) call read_error("Failure to read ramp command", iospara)
+
+        !Get the ramp dimensions
+        select case(ddim)
+        case('x','X')
+            j = 1
+        case('y','Y')
+            j = 2
+        case('z','Z')
+            j = 3
+        end select
+
+        select case(rdim)
+        case('x','X')
+            k = 1
+        case('y','Y')
+            k = 2
+        case('z','Z')
+            k = 3
+        end select
+        
+        !Get the displacement magnitude
+        disp = rhi-rlo
+
+        !Parse the displacement hi and lo positions
+        call parse_pos(j, txtvec(1), lo)
+        call parse_pos(j, txtvec(2), hi)
+
+        !Get group number
+        gnum = get_group_index(g)
+        if(gnum == 0) then 
+            call misc_error("Group "//trim(adjustl(g))// " in ramp command has not been defined. "// &
+                            "Please define group before use")
+        end if
+        
+        !Now displace points
+        do ia = 1, atom_num_l
+            if(btest(a_mask(ia), gnum)) then 
+                if(r_atom(j,ia) > hi) then 
+                    frac = 1.0_wp
+                else if(r_atom(j,ia) < lo) then 
+                    frac = 0.0_wp
+                else
+                    frac = (r_atom(j,ia) - lo)/(hi-lo)
+                end if
+                r_atom(k,ia) = r_atom(k, ia) + frac*disp + rlo
+            end if
+        end do
+        do ip = 1, node_num_l
+            ie = node_cg(ip)
+            if(btest(e_mask(ie), gnum)) then
+                do ibasis = 1, basis_num(ie)
+                    if(r(j,ibasis,ip) > hi) then 
+                        frac = 1.0_wp
+                    else if(r(j,ibasis,ip) < lo) then 
+                        frac = 0.0_wp
+                    else
+                        frac = (r(j, ibasis, ip) - lo)/(hi-lo)
+                    end if
+                    r(k, ibasis, ip) = r(k, ibasis, ip) + frac*disp + rlo
+                end do
+            end if
+        end do
+
+        if(nei_init) then 
+            call update_neighbor(iter, .false., .true.)
+        end if
+
+        return
+    end subroutine ramp_displace
+
+end module displace

src/dump.f90

@@ -0,0 +1,831 @@
+module dump
+    !
+    use atom_types
+    use parameters
+    use comms
+    use elements
+    use box
+    use errors
+    use forces
+    use math
+    use group
+    use time
+
+    implicit none
+
+    !Dump command parameters
+    integer, parameter :: max_dumps = 20
+    integer, private :: dump_num 
+    integer, dimension(max_dumps), private :: dump_every, dump_type, dump_group
+    character(len = read_len), dimension(max_dumps), private :: base_filename, dump_name
+
+
+    !Gather arrays for atoms
+    integer, parameter :: max_send_count = 1024
+    integer, allocatable, save :: tag_atom_gather(:), type_atom_gather(:), a_mask_gather(:)
+    real(kind=wp), allocatable, save :: r_atom_gather(:,:), energy_atom_gather(:), force_atom_gather(:,:), &
+                                        virial_atom_gather(:,:,:), vel_atom_gather(:,:)
+    !Gather arrays for elements
+    integer, allocatable, save :: tag_ele_gather(:), size_ele_gather(:), etype_gather(:), &
+                                  basis_num_gather(:), basis_type_gather(:,:), e_mask_gather(:)
+    real(kind=wp), allocatable, save :: r_gather(:,:,:), energy_gather(:,:), force_gather(:,:,:), virial_gather(:,:,:,:), &
+                                        vel_gather(:,:,:)
+
+    !Gather arrays for interpolated atoms
+    integer, allocatable :: atomap_mask_gather(:), type_atomap_gather(:)
+    real(kind = wp), allocatable, save :: r_atomap_gather(:,:)
+
+
+    public 
+    contains
+
+    subroutine dump_defaults
+        dump_every = huge(1)
+        dump_num = 0
+    end subroutine dump_defaults
+
+    subroutine parse_dump(line)
+        !Parse the dump command
+        character(len = *), intent(in) :: line
+        character(len = read_len) :: label, tmptxt, msg, dtype, dgroup
+        integer :: iospara, ppos
+
+        dump_num = dump_num + 1
+        read(line,*, iostat=iospara) label, dump_name(dump_num), dgroup, dtype, dump_every(dump_num), base_filename(dump_num)
+        if(iospara > 0) call read_error("Failure to read dump command", iospara)
+        
+        !Check to make sure dump file format is correct
+        select case(dtype)
+        case('out')
+            dump_type(dump_num) = 1
+        case('lmp')
+            dump_type(dump_num) = 2
+        case default
+            write(tmptxt, *) "dump file format ", trim(adjustl(dtype)), " is not accepted"
+            call command_error(tmptxt)
+        end select
+
+        write(msg, *) "Writing output to ", trim(adjustl(base_filename(dump_num))), " using ", trim(adjustl(dtype)), " file format"
+        call log_msg(msg)
+
+        !Now get rid of the extension on the filename
+        ppos =  scan(base_filename(dump_num), ".")
+        if(ppos > 0) then 
+            base_filename(dump_num)(ppos:ppos+3) = ''
+        end if
+
+        !Parse the dump group
+        dump_group(dump_num) = get_group_index(dgroup)
+        if(dump_group(dump_num) > group_num) then 
+            write(msg, *) "Group ", dgroup, " has not been created, please select an existing group to dump"
+            call command_error(msg)
+        end if
+
+        !Now if dump every = 0 set it to a very large number 
+        if (dump_every(dump_num) == 0) then 
+            dump_every(dump_num) = (huge(1))
+        end if
+
+        return
+    end subroutine  parse_dump
+
+    subroutine parse_undump(line)
+        !This deletes a dump command from memory
+        character(len=*) :: line
+
+        integer :: i, iospara
+        character(len=read_len) :: undump_name, msg, tmp
+
+        !Parse the command to get the undump name
+        read(line, *, iostat = iospara, iomsg=msg) tmp, undump_name
+        if(iospara > 0) call read_error(msg, iospara)
+
+        !Now loop over all dump commands and delete the one that matches the name
+        do i = 1, dump_num
+            if(dump_name(i) == undump_name) then 
+                dump_name(i:dump_num-1) = dump_name(i+1:dump_num)
+                dump_every(i:dump_num-1) = dump_every(i+1:dump_num)
+                dump_type(i:dump_num-1) = dump_type(i+1:dump_num)
+                dump_group(i:dump_num-1) = dump_group(i+1:dump_num)
+                base_filename(i:dump_num-1) = base_filename(i+1:dump_num)
+                dump_num = dump_num -1
+                exit
+            end if
+        end do
+        return
+    end subroutine  parse_undump
+
+    subroutine parse_write_out(line)
+        !Parse the dump command
+        integer :: type_for_dump, dg
+        character(len = *), intent(in) :: line
+        character(len = read_len) :: label, tmptxt, msg, dtype, dgroup, fname
+        integer :: iospara, ppos
+
+        fname=''
+        read(line,*, iostat=iospara) label, dgroup, dtype, fname
+        if(iospara > 0) call read_error("Failure to read write_out command", iospara)
+        if(fname=='') call misc_error('Missing filename for write_out command' )
+        
+        !Check to make sure dump file format is correct
+        select case(dtype)
+        case('out')
+            type_for_dump=1
+        case('lmp')
+            type_for_dump=2
+        case default
+            write(tmptxt, *) "dump file format ", trim(adjustl(dtype)), " is not accepted"
+            call command_error(tmptxt)
+        end select
+
+        write(msg, *) "Writing output to ", trim(adjustl(fname)), " using ", trim(adjustl(dtype)), " file format"
+        call log_msg(msg)
+
+        !Parse the dump group
+        dg = get_group_index(dgroup)
+        if(dg > group_num) then 
+            write(msg, *) "Group ", dgroup, " has not been created, please select an existing group to dump"
+            call command_error(msg)
+        end if
+
+        !Now write it out
+        if(atom_num > 0) call gather_at
+        if((ele_num > 0).and.(type_for_dump == 1)) call gather_cg
+        if((ele_num > 0).and.(type_for_dump == 2)) call gather_atomap
+        !Loop over all dumps and check to see if any need to be written
+        if(rank == root) then 
+            select case (type_for_dump)
+            case(1) 
+                call write_pycac(iter, trim(adjustl(fname)), dg)
+            case(2) 
+                call write_lmp(trim(adjustl(fname)), dg)
+            end select
+        end if
+
+        call dealloc_gather
+
+        return
+    end subroutine  parse_write_out
+
+    subroutine write_dump(timestep, force_dump)
+        !This subroutine converts the timestep to the filename and writes the correctly formatted dump file
+        integer, intent(in) :: timestep
+        logical, intent(in), optional :: force_dump
+
+        integer :: i 
+        character(len = read_len) :: fname
+        logical :: gathered, want_dump
+        
+        if(present(force_dump)) then 
+            want_dump = force_dump
+        else 
+            want_dump = .false.
+        end if
+
+        gathered = .false.
+        do i = 1, dump_num
+            if((mod(timestep, dump_every(i)) == 0).or.want_dump) then 
+                !Gather arrays if needed
+                if(.not.gathered) then 
+                    if(atom_num > 0) call gather_at
+                    if((ele_num > 0).and.any(dump_type == 1)) call gather_cg
+                    if((ele_num > 0).and.any(dump_type == 2)) call gather_atomap
+                    gathered = .true.
+                end if
+                !Loop over all dumps and check to see if any need to be written
+                write(fname, *) iter
+                
+                if(rank == root) then 
+                    select case (dump_type(i))
+                    case(1) 
+                        call write_pycac(iter, trim(adjustl(base_filename(i)))//trim(adjustl(fname))//".out", dump_group(i))
+                    case(2) 
+                        call write_lmp(trim(adjustl(base_filename(i)))//trim(adjustl(fname))//".lmp", dump_group(i))
+                    end select
+                end if
+            end if
+        end do
+
+        if(gathered) call dealloc_gather
+
+    end subroutine write_dump
+
+    subroutine dealloc_gather
+        !Deallocate gather arrays when no longer needed
+        if(allocated(tag_ele_gather)) then 
+            deallocate(tag_ele_gather, size_ele_gather, etype_gather, basis_num_gather, basis_type_gather, e_mask_gather, &
+                       r_gather, energy_gather, force_gather, virial_gather, stat=allostat) 
+            if(allostat > 0) call alloc_error("Failure to deallocate cg gather arrays", allostat)
+            if(need_vel) deallocate(vel_gather)
+        end if
+
+        if(allocated(tag_atom_gather)) then 
+            deallocate(tag_atom_gather, type_atom_gather, a_mask_gather, r_atom_gather, energy_atom_gather, &
+                       force_atom_gather, virial_atom_gather, stat = allostat)
+            if(allostat > 0) call alloc_error("Failure to deallocate at gather arrays", allostat)
+            if(need_vel) deallocate(vel_atom_gather)
+
+        if(allocated(type_atomap_gather)) then 
+            deallocate(r_atomap_gather, type_atomap_gather, atomap_mask_gather, stat = allostat)
+            if(allostat > 0) call alloc_error("Failure to deallocate atomap gather arrays", allostat)
+        end if
+        end if
+    end subroutine dealloc_gather
+
+    subroutine gather_cg
+        integer :: n_ints, n_reals, ntot_ints, ntot_reals, packet_num, ie, ip, ireal, iint, &
+                   n, je, jp, pro, inod, i, pb_in(3,max_basisnum, ng_max_node)
+        real(kind=wp) :: r_nodes(3, max_basisnum, ng_max_node), force_nodes(3, max_basisnum, ng_max_node), &
+                         eng_nodes(max_basisnum, ng_max_node), virial_nodes(3,3,max_basisnum,ng_max_node),&
+                         vel_nodes(3, max_basisnum, ng_max_node)
+        integer, allocatable :: gather_ints(:), send_ints(:)
+        real(kind=wp), allocatable :: gather_reals(:), send_reals(:)
+
+        !Allocate gather arrays if necessary
+        if(rank == root) then 
+            allocate(tag_ele_gather(ele_num), size_ele_gather(ele_num), etype_gather(ele_num), e_mask_gather(ele_num), & 
+                     basis_num_gather(ele_num), basis_type_gather(max_basisnum, ele_num), &
+                     r_gather(3, max_basisnum, node_num), energy_gather(max_basisnum, node_num), &
+                     force_gather(3, max_basisnum, node_num), virial_gather(3,3,max_basisnum,node_num), stat=allostat)
+            if (allostat > 0) call alloc_error("Failure to allocate gather arrays", allostat)
+            if(need_vel) allocate(vel_gather(3, max_basisnum, node_num), stat=allostat)
+            if (allostat > 0) call alloc_error("Failure to allocate vel gather arrays", allostat)
+
+        end if
+
+        !Now allocate the send_arrays
+        n_ints = 5+max_basisnum
+        ntot_ints = max_send_count*n_ints
+
+        if(need_vel) then 
+            n_reals = 22*max_basisnum*ng_max_node
+        else
+            n_reals = 19*max_basisnum*ng_max_node
+        end if
+        ntot_reals = max_send_count*n_reals
+
+        allocate(send_ints(ntot_ints), send_reals(ntot_reals), stat = allostat)
+        if (allostat > 0 ) call alloc_error("Failure to allocate send arrays for cg comm in gather_in_root", allostat)
+        !Only allocate gather arrays on root
+        if(rank == root) then 
+            allocate(gather_ints(pro_num*ntot_ints), gather_reals(pro_num*ntot_reals))
+            if (allostat > 0 ) call alloc_error("Failure to allocate gather arrays for cg comm in gather_cg", allostat)
+        else
+            allocate(gather_ints(0), gather_reals(0))
+            if (allostat > 0 ) call alloc_error("Failure to allocate gather arrays for cg comm in gather_cg", allostat)
+        end if
+
+        !Now build the local send buff array
+        vel_nodes=0.0_wp
+        packet_num = 0
+        ip = 0 
+        ie = 0
+        je = 0
+        jp = 0
+        iint = 0
+        ireal = 0
+        send_ints(:) = 0
+        send_reals(:) = 0.0_wp
+        pb_in = 0
+
+        if (rank == root) then 
+            gather_ints(:) = 0
+            gather_reals(:) = 0.0_wp
+        end if
+        do while (ie < ele_num) 
+            if( (je == ele_num_l).or.(packet_num == max_send_count) ) then 
+                !If we have sent/packed all of our elements or if this packet is equal to send_counts then we communicate
+                !Gather integer data
+                call mpi_gather(send_ints, ntot_ints, mpi_integer, gather_ints, ntot_ints, mpi_integer, root, world, ierr)
+                !Gather real data
+                call mpi_gather(send_reals, ntot_reals, mpi_wp, gather_reals, ntot_reals, mpi_wp, root, world, ierr)
+                !If root then loop over all received values and unpack
+                if (rank == root) then 
+                    outerloop:do pro= 1, pro_num
+                        innerloop:do i = 1, max_send_count
+                            !Index the start point for the current element in the array
+                            ireal=n_reals*((pro-1)*max_send_count + (i-1))
+                            iint = n_ints*((pro-1)*max_send_count + (i-1))
+
+                            !If this buffer in the array is 0 then we move it ahead to where the next processor beings
+                            if (ie == ele_num) then 
+                                exit outerloop 
+                            !Exit if ie == ele_num
+                            else if(gather_ints(iint+1) == 0) then 
+                                exit innerloop
+                            end if
+
+                            ie = ie + 1
+
+                            !Unpack the received buffer for the current element
+                            call unpack_ele_dump(gather_ints(iint+1:iint+n_ints), gather_reals(ireal+1:ireal+n_reals), &
+                                                 etype_gather(ie), tag_ele_gather(ie), size_ele_gather(ie), e_mask_gather(ie), &
+                                                 basis_num_gather(ie), basis_type_gather(:,ie), r_nodes, eng_nodes, &
+                                                 force_nodes, virial_nodes, vel_nodes)
+
+                            !Set nodal quantities
+                            n = ng_node(etype_gather(ie))
+                            r_gather(:,:,ip+1:ip+n) = r_nodes(:,:,1:n)
+                            energy_gather(:,ip+1:ip+n) = eng_nodes(:,1:n)
+                            force_gather(:,:,ip+1:ip+n) = force_nodes(:,:,1:n)
+                            virial_gather(:,:,:,ip+1:ip+n) = virial_nodes(:,:, :,1:n)
+
+                            if(need_vel) vel_gather(:,:,ip+1:ip+n) = vel_nodes(:,:,1:n)
+
+                            ip = ip + n
+                        end do innerloop
+                    end do outerloop
+                end if
+
+                !broadcast gathered num to see if we need to continue in the loop
+                call mpi_bcast(ie, 1, mpi_int, root, world, ierr)
+                
+                !gathered_num can't be more than ele_num
+                if(ie > ele_num) then 
+                    call misc_error("Gathered_num  can't be larger than ele_num ")
+                end if
+                !Zero out arrays to reset for next round of communications
+                packet_num = 0
+                send_ints(:) = 0
+                send_reals(:) = 0.0_wp
+                ireal = 0
+                iint = 0
+            else
+                !We aren't ready to communicate so keep packing  
+                je = je+1   
+                
+                if(je > ele_num_l) call misc_error("je greater than ele_num_l in gather_cg")
+                if(who_has_ele(je)) then 
+                    !get the node positions
+                    do inod = 1, ng_node(etype(je))
+                        jp = cg_node(inod, je)
+                        r_nodes(:,:,inod) = r(:,:,jp)
+                        eng_nodes(:,inod) = energy_eq(:,jp)
+                        force_nodes(:,:,inod) = force_eq(:, :, jp)
+                        virial_nodes(:,:,:,inod) = virial_eq(:,:,:,jp)
+                        if(periodic) then 
+                            pb_in(:,:,inod) = pb_node(:,:,jp)
+                        end if
+                        if(need_vel) vel_nodes(:,:,inod) = vel(:,:,jp)
+                    end do
+                    
+                    !Get the start position for the data in the send arrays
+                    ireal=n_reals*(packet_num) 
+                    iint = n_ints*(packet_num)
+
+                    call pack_ele_dump(etype(je), tag_ele(je), size_ele(je), e_mask(je), basis_num(je), basis_type(:, je), &
+                                       pb_in, r_nodes, eng_nodes, force_nodes, virial_nodes, vel_nodes,&
+                                       send_ints(iint+1:iint+n_ints), send_reals(ireal+1:ireal+n_reals))
+                    !Increment the packet num
+                    packet_num = packet_num + 1
+                end if
+            end if
+        end do 
+        return
+    end subroutine gather_cg
+
+    subroutine gather_at
+        !Gather all atoms to root processor
+        integer :: ia, ja, n_ints, n_reals, ntot_ints, ntot_reals, packet_num, ireal, iint, pro, i
+
+        integer, allocatable :: gather_ints(:), send_ints(:)
+        real(kind=wp) :: v(3)
+        real(kind=wp), allocatable :: gather_reals(:), send_reals(:)
+
+        !Allocate gather arrays if necessary
+        if(rank == root) then 
+            allocate(tag_atom_gather(atom_num), type_atom_gather(atom_num), a_mask_gather(atom_num), r_atom_gather(3, atom_num), &
+                     energy_atom_gather(atom_num), force_atom_gather(3,atom_num), virial_atom_gather(3,3,atom_num), &
+                     stat = allostat)
+            if (allostat > 0) call alloc_error("Failure to allocate gather at arrays", allostat)
+
+            if(need_vel) allocate(vel_atom_gather(3,atom_num), stat = allostat)
+            if (allostat > 0) call alloc_error("Failure to allocate vel at arrays", allostat)
+
+        end if
+
+        !Now allocate the send_arrays
+        n_ints = 3
+        ntot_ints = max_send_count*n_ints
+
+        if(need_vel) then 
+            n_reals=22
+        else
+            n_reals = 19
+        end if
+        ntot_reals = max_send_count*n_reals
+
+        allocate(send_ints(ntot_ints), send_reals(ntot_reals), stat = allostat)
+        if (allostat > 0 ) call alloc_error("Failure to allocate send arrays for cg comm in gather_in_root", allostat)
+
+        !Only allocate gather arrays on root
+        if(rank == root) then 
+            allocate(gather_ints(pro_num*ntot_ints), gather_reals(pro_num*ntot_reals))
+            if (allostat > 0 ) call alloc_error("Failure to allocate gather arrays for cg comm in gather_cg", allostat)
+        else
+            allocate(gather_ints(0), gather_reals(0))
+            if (allostat > 0 ) call alloc_error("Failure to allocate gather arrays for cg comm in gather_cg", allostat)
+        end if
+
+        !Now build the local send buff array
+        packet_num = 0
+        iint = 0
+        ireal = 0
+        ia = 0
+        ja = 0
+        v(:) = 0.0_wp
+        send_ints(:) = 0
+        send_reals(:) = 0.0_wp
+
+        if (rank == root) then 
+            gather_ints(:) = 0
+            gather_reals(:) = 0.0_wp
+        end if
+        do while (ia < atom_num) 
+            if( (ja == atom_num_l).or.(packet_num == max_send_count) ) then 
+                !If we have sent/packed all of our atoms or if this packet is equal to send_counts then we communicate
+                !Gather integer data
+                call mpi_gather(send_ints, ntot_ints, mpi_integer, gather_ints, ntot_ints, mpi_integer, root, world, ierr)
+                !Gather real data
+                call mpi_gather(send_reals, ntot_reals, mpi_wp, gather_reals, ntot_reals, mpi_wp, root, world, ierr)
+                !If root then loop over all received values and unpack
+                if (rank == root) then 
+                    outerloop:do pro= 1, pro_num
+                        innerloop:do i = 1, max_send_count
+                            !Index the start point for the current element in the array
+                            ireal=n_reals*((pro-1)*max_send_count + (i-1))
+                            iint = n_ints*((pro-1)*max_send_count + (i-1))
+
+                            !If this buffer in the array is 0 then we move it ahead to where the next processor beings
+                            !Exit if ia == atom_num
+                            if (ia == atom_num) then 
+                                exit outerloop 
+                            else if(gather_ints(iint+1) == 0) then 
+                                exit innerloop
+                            end if
+
+                            ia = ia + 1
+
+                            !Unpack the received buffer for the current element
+                            call unpack_atom_dump(gather_ints(iint+1:iint+n_ints), gather_reals(ireal+1:ireal+n_reals), &
+                                                  tag_atom_gather(ia), type_atom_gather(ia), a_mask_gather(ia), &
+                                                  r_atom_gather(:,ia), energy_atom_gather(ia), force_atom_gather(:,ia),&
+                                                  virial_atom_gather(:,:,ia), v(1:3))
+
+                            if(need_vel) vel_atom_gather(:,ia) = v(1:3)
+
+                        end do innerloop
+                    end do outerloop
+                end if
+
+                !broadcast gathered num to see if we need to continue in the loop
+                call mpi_bcast(ia, 1, mpi_int, root, world, ierr)
+                
+                !ia can't be more than atom_num 
+                if(ia > atom_num) then 
+                    call misc_error("Gathered_num  can't be larger than atom_num ")
+                end if
+                !Zero out arrays to reset for next round of communications
+                packet_num = 0
+                send_ints(:) = 0
+                send_reals(:) = 0.0_wp
+                ireal = 0
+                iint = 0
+            else
+                !We aren't ready to communicate so keep packing  
+                ja = ja+1   
+                
+                if(ja > atom_num_l) call misc_error("ja greater than atom_num_l in gather_cg")
+                !Get the start position for the data in the send arrays
+                ireal=n_reals*(packet_num) 
+                iint = n_ints*(packet_num)
+
+                if(need_vel) v(:) = vel_atom(:,ja)
+                call pack_atom_dump(tag_atom(ja), type_atom(ja), a_mask(ja), r_atom(:,ja), energy_atom(ja), force_atom(:,ja), &
+                                    virial_atom(:,:, ja), v, send_ints(iint+1:iint+n_ints), send_reals(ireal+1:ireal+n_reals))
+
+                !Increment the packet num
+                packet_num = packet_num + 1
+            end if
+        end do 
+        return
+    end subroutine gather_at
+
+
+    subroutine gather_atomap
+        !This subroutine gathers atomap information. This is required to get the correct atomistic positions for
+        !NVT simulations
+        integer :: ia, ja, ntot_ints, ntot_reals, packet_num, ireal, iint, pro, i, &
+                   atomap_mask(atomap_num_l), ie, iatom, iatomap, virt_count, ibasis
+
+        integer, allocatable :: gather_ints(:), send_ints(:)
+        real(kind=wp), allocatable :: gather_reals(:), send_reals(:)
+
+        !Allocate gather arrays if necessary
+        ntot_ints = 2*max_send_count
+        ntot_reals = 3*max_send_count
+
+        if(rank == root) then 
+            allocate(r_atomap_gather(3, atomap_num), type_atomap_gather(atomap_num), atomap_mask_gather(atomap_num), &
+                     stat = allostat)
+            if (allostat > 0) call alloc_error("Failure to allocate gather atomap arrays", allostat)
+
+            allocate(gather_ints(pro_num*ntot_ints), gather_reals(pro_num*ntot_reals), stat=allostat)
+            if(allostat > 0) call alloc_error("Failure to allocate gather account", allostat)
+        else
+            allocate(gather_ints(0), gather_reals(0), stat=allostat)
+            if(allostat > 0) call alloc_error("Failure to allocate gather account", allostat)
+
+        end if
+
+        !Now allocate the send_arrays
+        allocate(send_ints(ntot_ints), send_reals(ntot_reals), stat = allostat)
+        if (allostat > 0 ) call alloc_error("Failure to allocate send arrays for cg comm in gather_in_root", allostat)
+
+        !First get the group positions for all atomaps
+        do ie = 1, ele_num_l
+            select case(etype(ie))
+            case(1,2,3)
+                virt_count=(size_ele(ie)+1)**3
+            end select
+            do iatom= 1, virt_count
+                do ibasis = 1, basis_num(ie)
+                    iatomap = cg_atomap(basis_num(ie)*(iatom-1) + ibasis, ie)
+                    if(iatomap /= 0) then 
+                        atomap_mask(iatomap) = e_mask(ie) 
+                    end if
+                end do
+            end do
+        end do
+
+
+        packet_num = 0
+        iint = 0
+        ireal = 0
+        ia = 0
+        ja = 0
+        send_ints(:) = 0
+        send_reals(:) = 0.0_wp
+
+        if(rank == root) then 
+            gather_ints(:) = 0
+            gather_reals(:) = 0.0_wp
+        end if
+        do while (ia < atomap_num) 
+            if( (ja == atomap_num_l).or.(packet_num == max_send_count) ) then 
+                !If we have sent/packed all of our atoms or if this packet is equal to send_counts then we communicate
+                !Gather integer data
+                call mpi_gather(send_ints, ntot_ints, mpi_integer, gather_ints, ntot_ints, mpi_integer, root, world, ierr)
+                !Gather real data
+                call mpi_gather(send_reals, ntot_reals, mpi_wp, gather_reals, ntot_reals, mpi_wp, root, world, ierr)
+                !If root then loop over all received values and unpack
+                if (rank == root) then 
+                    outerloop:do pro= 1, pro_num
+                        innerloop:do i = 1, max_send_count
+                            !Index the start point for the current element in the array
+                            ireal=3*((pro-1)*max_send_count + (i-1))
+                            iint =2*((pro-1)*max_send_count + (i-1))
+
+                            !If this buffer in the array is 0 then we move it ahead to where the next processor beings
+                            !Exit if ia == atom_num
+                            if (ia == atomap_num) then 
+                                exit outerloop 
+                            else if(gather_ints(iint+1) == 0) then 
+                                exit innerloop
+                            end if
+
+                            ia = ia + 1
+
+                            !Unpack the received buffer for the current element
+                            type_atomap_gather(ia) = gather_ints(iint+1)
+                            atomap_mask_gather(ia) = gather_ints(iint+2)
+                            r_atomap_gather(:, ia) = gather_reals(ireal+1:ireal+3)
+                        end do innerloop
+                    end do outerloop
+                end if
+
+                !broadcast gathered num to see if we need to continue in the loop
+                call mpi_bcast(ia, 1, mpi_int, root, world, ierr)
+                
+                !ia can't be more than atom_num 
+                if(ia > atomap_num) then 
+                    call misc_error("Gathered_num  can't be larger than atom_num ")
+                end if
+                !Zero out arrays to reset for next round of communications
+                packet_num = 0
+                send_ints(:) = 0
+                send_reals(:) = 0.0_wp
+                ireal = 0
+                iint = 0
+            else
+                !We aren't ready to communicate so keep packing  
+                ja = ja+1   
+                
+                if(ja > atomap_num_l) call misc_error("ja greater than atom_num_l in gather_cg")
+                !Get the start position for the data in the send arrays
+                ireal=3*(packet_num) 
+                iint = 2*(packet_num)
+
+                
+                send_ints(iint+1) = type_atomap(ja)
+                send_ints(iint+2) = atomap_mask(ja)
+                send_reals(ireal+1:ireal+3) = r_atomap(:,ja)
+                !Increment the packet num
+                packet_num = packet_num + 1
+            end if
+        end do
+        return
+    end subroutine gather_atomap
+
+    subroutine write_pycac(timestep, filename, g)
+        integer, intent(in) :: timestep, g
+        character(len=*), intent(in) :: filename
+        integer :: i, ia, ie, ip, ibasis, inod, write_atoms, write_eles
+        real(kind=wp) :: v_vec(6)
+
+        !Write pycac dump file
+1 format("#This is a pycac dump file created using the quasi-static CAC code"/ &
+         "Can be converted using cacmb code from https://gitlab.com/aselimov/cacmb")
+2 format("Atoms: ", i16, " Elements:", i16)
+3 format("Atom format: id atom_type x y z pe fx fy fz v11 v22 v33 v32 v31 v21")
+13 format("Atom format: id atom_type x y z pe fx fy fz v11 v22 v33 v32 v31 v21 velx vely velz")
+4 format('Element format: id num_node num_basis esize')
+5 format('Node format: ip ib basis_type x y z pe fx fy fz v11 v22 v33 v32 v31 v21')
+15 format('Node format: ip ib basis_type x y z pe fx fy fz v11 v22 v33 v32 v31 v21 velx vely velz')
+6 format("Timestep: ", i16)
+7 format("Box_bd ", 3a, 6f23.15)
+        
+        !First get counts of atoms/elements in write group
+        !If group is all then it's just atom_num and ele_num
+        if (g == 1) then 
+            write_atoms = atom_num
+            write_eles = ele_num
+        else
+            write_atoms = 0
+            write_eles = 0
+            do i = 1, atom_num
+                if(btest(a_mask_gather(i),g)) write_atoms = write_atoms + 1
+            end do
+            do i =1, ele_num
+                if (btest(e_mask_gather(i), g)) write_eles = write_eles + 1
+            end do
+        end if
+        !Open file if root
+        open(unit=11, file=trim(adjustl(filename)), action='write', status='replace', position='rewind')
+        !Write header information 
+        write(11, 1)
+        write(11, 6) timestep
+        write(11, 2) write_atoms, write_eles
+        write(11, 7) (boundary(i:i)//" ", i = 1, 3), (box_bd(i), i = 1, 6)
+
+        !get the atom type number into the form string
+        write(11, '(a, 999(f23.15,1x))') "Masses: ", (masses(i), i = 1, natom_types)
+
+        !First write the atom section if needed
+        if (atom_num > 0) then 
+            !Write atom header
+            if(need_vel) then 
+                write(11,13)
+            else
+                write(11,3)
+            end if
+            do ia = 1, atom_num
+                if(btest(a_mask_gather(ia), g)) then 
+                    !Assign virial vector
+                    v_vec(1) = virial_atom_gather(1,1,ia)
+                    v_vec(2) = virial_atom_gather(2,2,ia)
+                    v_vec(3) = virial_atom_gather(3,3,ia)
+                    v_vec(4) = virial_atom_gather(3,2,ia)
+                    v_vec(5) = virial_atom_gather(3,1,ia)
+                    v_vec(6) = virial_atom_gather(2,1,ia)
+                    
+                    if (need_vel) then 
+                        write(11, *) tag_atom_gather(ia), type_atom_gather(ia), r_atom_gather(:,ia), &
+                                                      energy_atom_gather(ia), force_atom_gather(:,ia), v_vec(:), &
+                                                      vel_atom_gather(:,ia)
+                    else
+                        write(11, *) tag_atom_gather(ia), type_atom_gather(ia), r_atom_gather(:,ia), &
+                                                      energy_atom_gather(ia), force_atom_gather(:,ia), v_vec(:)
+                    end if
+                end if
+            end do
+        end if
+
+        if(ele_num > 0) then 
+            !Write cg header
+            write(11,4)
+            if(need_vel) then 
+                write(11,15)
+            else
+                write(11,5)
+            end if
+            ip=0
+            do ie = 1, ele_num
+                if(btest(e_mask_gather(ie), g)) then 
+                    !Write element information
+                    write(11,'(4i16)' ) tag_ele_gather(ie), ng_node(etype_gather(ie)), basis_num_gather(ie), size_ele_gather(ie)
+                    !write node information
+                    do inod = 1, ng_node(etype_gather(ie))
+                        ip = ip + 1    
+                        do ibasis = 1, basis_num_gather(ie)
+                            v_vec(1) = virial_gather(1, 1, ibasis, ip)
+                            v_vec(2) = virial_gather(2, 2, ibasis, ip)
+                            v_vec(3) = virial_gather(3, 3, ibasis, ip)
+                            v_vec(4) = virial_gather(3, 2, ibasis, ip)
+                            v_vec(5) = virial_gather(3, 1, ibasis, ip)
+                            v_vec(6) = virial_gather(2, 1, ibasis, ip)
+                            if(need_vel) then 
+                                write(11, *) inod, ibasis, basis_type_gather(ibasis, ie), r_gather(:,ibasis,ip), &
+                                            energy_gather(ibasis,ip), force_gather(:, ibasis, ip), v_vec(:), &
+                                            vel_gather(:, ibasis,ip)
+                            else
+                                write(11, *) inod, ibasis, basis_type_gather(ibasis, ie), r_gather(:,ibasis,ip), &
+                                            energy_gather(ibasis,ip), force_gather(:, ibasis, ip), v_vec(:)
+                            end if
+                        end do
+                    end do
+                end if
+            end do
+        end if
+
+        close(11)
+        return
+    end subroutine write_pycac
+
+    subroutine write_lmp(filename, g)
+        integer, intent(in) :: g
+        character(len = *) :: filename  
+
+        integer :: i, write_num =0, max_atom_tag 
+
+        open(unit=11, file=trim(adjustl(filename)), action='write', status='replace', position='rewind')
+
+        !Write comment line
+        write(11, '(a)') '# lmp file made using CAC code'
+        write(11, '(a)') 
+
+        !Calculate total atom number to write
+        write_num = 0
+        do i = 1, atom_num
+            if (btest(a_mask_gather(i), g)) write_num = write_num + 1
+        end do
+        do i = 1, atomap_num
+            if (btest(atomap_mask_gather(i), g)) write_num = write_num + 1 
+        end do
+
+        !Write total number of atoms + interpolated atoms
+        write(11, '(i16, a)') write_num, ' atoms'
+        !Write number of atom types
+        write(11, '(i16, a)') natom_types, ' atom types'
+
+        write(11, '(a)') 
+        !Write box boundaries
+        write(11, '(2f23.15, a)') box_bd(1:2), ' xlo xhi'
+        write(11, '(2f23.15, a)') box_bd(3:4), ' ylo yhi'
+        write(11, '(2f23.15, a)') box_bd(5:6), ' zlo zhi'
+
+        !Masses
+        write(11, '(a)') 'Masses'
+
+        write(11, '(a)') 
+        do i = 1, natom_types
+            write(11, '(i16, f23.15)') i, masses(i)
+        end do
+        write(11, '(a)') 
+        
+        !Now first write atom positions
+        write(11, '(a)') 'Atoms'
+        write(11, '(a)') 
+
+        do i = 1, atom_num
+            if (btest(a_mask_gather(i), g)) then 
+                write(11, '(2i16, 3f23.15)') tag_atom_gather(i), type_atom_gather(i), r_atom_gather(:,i)
+            end if
+        end do
+
+        max_atom_tag = maxval(tag_atom_gather)
+        do i = 1, atomap_num
+            if (btest(atomap_mask_gather(i), g)) then 
+                write(11, '(2i16, 3f23.15)') max_atom_tag+i, type_atomap_gather(i), r_atomap_gather(:,i)
+            end if
+        end do
+
+        close(11)
+        return
+    end subroutine write_lmp
+
+    pure function need_dump(time)
+        integer, intent(in) :: time
+        logical :: need_dump
+        integer :: i
+
+        need_dump = .false.
+        do i = 1, dump_num
+            if(mod(time, dump_every(i)) == 0) then 
+                need_dump = .true.
+                return
+            end if
+        end do
+        return
+    end function need_dump
+end module dump

src/dynamics.f90

@@ -0,0 +1,195 @@
+module dynamics
+
+    !This code contains the code needed to run the various types of dynamics
+    use parameters
+    use vel_verlet
+    use neighbors
+    use quenched_dynamics
+    use forces
+    use comms
+    use potential
+    use dump
+    use thermo
+    use time
+    use temp
+    use berendsen
+    use deform
+
+    implicit none
+
+    real(kind=wp), save :: itime
+    character(len = 100) :: ensemble
+    integer :: ensemble_option
+
+    private :: pre_step, post_step, step
+    public
+    contains
+
+    subroutine dynamics_defaults
+        ensemble_option = 0 
+        ensemble = "none"
+    end subroutine dynamics_defaults
+
+    subroutine parse_dynamics(line)
+        character(len = *), intent(in) :: line
+        
+        character(len=read_len) tmptxt
+        integer :: iospara
+
+        read(line, *, iostat = iospara) tmptxt, ensemble
+        if (iospara > 0) call read_error("Invalid read of dynamics command", iospara)
+
+        select case(ensemble)
+        case("none")
+            ensemble_option = 0
+            if(rank==root) call log_msg("Warning: no dynamics specified. Atom positions will not evolve")
+        case('NVE', 'nve')
+            ensemble_option = 1
+        case('qd')
+            ensemble_option = 2
+        case('eu')
+            ensemble_option = 3
+        case('ld')
+            ensemble_option = 4 
+        case default 
+            call command_error("Ensemble "//trim(adjustl(ensemble))//" is not currently accepted as an option for dynamics")
+        end select
+
+        return
+    end subroutine parse_dynamics
+
+    subroutine parse_run(line)
+        !parse the run command
+        character(len = *), intent(in) :: line
+        character(len=read_len) :: tmptxt
+        integer ::  iospara
+
+        begin_step = iter
+        read(line, *, iostat = iospara) tmptxt, run_steps
+        if (iospara > 0) call read_error("Invalid read of run command", iospara)
+        call run_dynamics(run_steps)
+
+    end subroutine parse_run
+
+    subroutine run_dynamics(num_steps)
+        !This subroutine actually runs the dynamics steps
+        integer, intent(in) :: num_steps
+
+        integer ::i
+
+        !Check to make sure timestep is greater than 0
+        if(time_step <= 0.0_wp) then 
+            call misc_error("Time_step was never set, please add command time_step val before run command")
+        end if
+        !Initialize the force calculation and the first dump
+
+        if(nei_init) then 
+            call update_neighbor(iter, .false., .true.)
+        else
+            if(ele_num > 0) call ghost_cg
+            if(atom_num> 0) call ghost_at
+            call neighbor_lists
+        end if
+        call update_force
+        if(first_run) call write_dump(iter, .true.)
+        call write_thermo_style
+        call write_thermo_out(iter)
+
+        do i = 1, num_steps
+            iter = iter + 1 
+            t = t+time_step
+
+            call pre_step(iter)
+            call step
+            call post_step(iter)
+        end do
+
+        need_virial = .true.
+        call update_force
+        call write_dump(iter, .true.)
+        call write_thermo_out(iter)
+
+        call log_neighbor_info
+        first_run = .false.
+
+    end subroutine run_dynamics
+
+    subroutine pre_step(i)
+        !This subroutine is run before each dynamics timestep is calculated
+        
+        !i is the current step number
+        integer, intent(in) ::i
+        
+        !If we are dumping this timestep then we need to calculate the virial stress
+        if(need_dump(i).or.pflag) need_virial = .true.
+
+        !Check to see if we need virial for the thermo command
+        if((mod(i,thermo_every)==0).and.need_p) need_virial = .true. 
+
+        call deform_box
+
+        return
+    end subroutine pre_step
+
+    subroutine post_step(i)
+        !This subroutine is run after the dynamics timestep is calculated
+        !i is the current step number
+        integer, intent(in) ::i
+
+        !Check to see if we need to rescale velocity
+        if(tflag) call rescale_v
+        
+        !Check to see if we need to dilate box
+        if(pflag) call rescale_box
+
+        !Dump check
+        call write_dump(i)
+
+        !Thermo if we need it 
+        if(mod(i,thermo_every)==0) call write_thermo_out(i)
+
+
+        need_virial = .false.
+
+        return
+    end subroutine post_step
+
+    subroutine step
+        !This subroutine calls the correct dynamics to run
+        !i is the current step number
+        select case(ensemble_option)
+        case(0)
+            continue
+        case(1)
+            call verlet(iter)
+        case(2)
+            call qd(iter)
+        case(3)
+            call euler(iter)        
+        end select
+        
+    end subroutine step
+
+    subroutine euler(iter)
+        integer, intent(in) :: iter
+
+        integer :: ip, ibasis, ia
+
+        do ip = 1, node_num_l
+            do ibasis=1, basis_num(node_cg(ip))
+                vel(:, ibasis, ip) = vel(:, ibasis, ip) + time_step*ftm2v/masses(basis_type(ibasis,node_cg(ip))) &
+                                                          *force_eq(:,ibasis,ip)
+                r(:, ibasis, ip) = r(:, ibasis, ip) + time_step*vel(:, ibasis,ip)
+            end do
+        end do
+
+        do ia = 1, atom_num_l
+            vel_atom(:,ia) = vel_atom(:,ia) + time_step*ftm2v/masses(type_atom(ia))*force_atom(:,ia)
+            r_atom(:,ia) = r_atom(:,ia) + time_step*vel_atom(:,ia)
+        end do
+
+        call update_neighbor(iter)
+        call update_force
+    end subroutine euler
+
+end module dynamics

src/elements.f90

@@ -0,0 +1,662 @@
+module elements
+
+    use parameters
+    use errors
+    use box
+    use math
+
+    implicit none
+    !This module contains all arrays and subroutines for processing atom and element data
+
+    !Variables to track the various global values
+    integer, save :: ele_num, node_num, atom_num, ng_max_node, max_basisnum, atomap_num, atomap_max
+
+    logical :: need_vel !this variable denotes if we need velocity arrays
+
+    !Variables to track various local values
+    integer, save :: ele_num_l, node_num_l, atom_num_l, atomap_num_l, ele_num_lr, node_num_lr, atom_num_lr, atomap_num_lr, &
+                     atomap_num_lg, atom_num_lg
+
+    !Current accepted element type definitions
+    integer, parameter :: defined_element_types=3 
+    character(len=5), parameter, dimension(defined_element_types) :: element_types = (/ '1NN', '2NN', '20C' /) 
+    logical, dimension(defined_element_types) :: etype_present 
+    integer, parameter, dimension(defined_element_types) :: ng_node = (/ 8, 8, 20 /) !Number of nodes per element
+    integer :: max_size !Max of size_ele
+
+    !Coarse-grained elements
+    integer, allocatable, save :: tag_ele(:), size_ele(:), etype(:), basis_num(:), basis_type(:,:), &
+                                  cg_node(:,:), node_cg(:), pb_node(:,:,:), cg_atomap(:,:), ele_glob_id(:), e_mask(:)
+    real(kind=wp), allocatable, save :: r(:,:,:), vel(:,:,:) !allocate to 3, max_basis_num, node_num_l, so it's nodal not
+                                                             ! by element
+
+    !Interpolated atoms
+    integer, allocatable, save :: tag_atomap(:), type_atomap(:), atomap_to_intpo(:,:)
+    real(kind=wp), allocatable, save :: r_atomap(:,:)
+     
+    !Interpolation variable
+    real(kind=wp), allocatable, save :: a_interpo(:,:,:,:)
+    integer :: unique_sizes 
+    integer, allocatable :: size_to_shape(:), shape_sizes(:)
+    logical, allocatable :: needed_atomap(:)
+
+    !Real atoms
+    integer, allocatable :: tag_atom(:), type_atom(:), a_mask(:)
+    real(kind=wp), allocatable :: r_atom(:,:), vel_atom(:,:)
+    public 
+    contains
+
+    subroutine alloc_at_arrays
+        !Allocate atom arrays
+        integer :: allostat
+
+        if(allocated(tag_atom)) deallocate(tag_atom, type_atom, a_mask, r_atom)
+
+        allocate( tag_atom(atom_num_l), &
+                  type_atom(atom_num_l), &
+                  a_mask(atom_num_l), &
+                  r_atom(3,atom_num_l), &
+                  stat=allostat)
+        if(allostat > 0) call alloc_error("Failed to allocate at_arrays", allostat)
+
+
+        tag_atom(:) = 0
+        type_atom(:) = 0
+        a_mask(:) = 0
+        r_atom = 0.0_wp
+
+        if(need_vel) then 
+            if(allocated(vel_atom)) deallocate(vel_atom)
+            allocate(vel_atom(3,atom_num_l), stat=allostat)
+            if(allostat > 0) call alloc_error("Failed to allocate vel_atom", allostat)
+            vel_atom = 0.0_wp
+        end if
+        return
+
+    end subroutine alloc_at_arrays
+
+    subroutine dealloc_at_arrays
+        !deallocate atom arrays
+        integer :: allostat
+        
+        deallocate( tag_atom, type_atom, a_mask, r_atom, stat=allostat)
+        if(allostat > 0) call alloc_error("Failed to deallocate at_arrays", allostat)
+
+        if(need_vel) then 
+            deallocate(vel_atom, stat=allostat)
+            if(allostat > 0) call alloc_error("Failed to deallocate vel_atom", allostat)
+        end if
+        return
+
+    end subroutine dealloc_at_arrays
+
+    subroutine alloc_velocity_arrays
+        if((ele_num > 0) .and..not.allocated(vel)) then 
+            allocate(vel(3, max_basisnum, node_num_lr), stat = allostat)
+            if (allostat > 0) call alloc_error("Failure to allocate vel in alloc_velocity array", allostat)
+            vel(:,:,:) = 0.0_wp
+        end if
+        if((atom_num > 0).and..not.allocated(vel_atom)) then 
+            allocate(vel_atom(3, atom_num_lr), stat = allostat)
+            if (allostat > 0) call alloc_error("Failure to allocate vel_atom in alloc_velocity array", allostat)
+            vel_atom(:,:) = 0.0_wp
+        end if
+    end subroutine alloc_velocity_arrays
+        
+    subroutine dealloc_velocity_arrays
+        if((ele_num > 0) .and..not.allocated(vel)) then 
+            deallocate(vel, stat = allostat)
+            if (allostat > 0) call alloc_error("Failure to deallocate vel in alloc_velocity array", allostat)
+        end if
+        if((atom_num > 0).and..not.allocated(vel_atom)) then 
+            deallocate(vel_atom, stat = allostat)
+            if (allostat > 0) call alloc_error("Failure to deallocate vel_atom in alloc_velocity array", allostat)
+        end if
+    end subroutine dealloc_velocity_arrays
+
+    subroutine grow_at_arrays(seg_real)
+        !Grow atom arrays
+        integer, intent(in), optional :: seg_real
+
+        integer :: grow_by
+        integer, allocatable :: tag_array(:), type_array(:), mask_array(:)
+        real(kind=wp), allocatable :: r_array(:,:), vel_array(:,:)
+
+        if (present(seg_real)) then
+            grow_by = seg_real
+        else 
+            grow_by = seg_num
+        end if
+
+        allocate( tag_array(atom_num_lr+grow_by), &
+                  type_array(atom_num_lr+grow_by),& 
+                  mask_array(atom_num_lr+grow_by),&
+                  r_array(3,atom_num_lr+grow_by), &
+                  stat=allostat)  
+        if(allostat > 0) call alloc_error("Failure allocating atom arrays in grow_at_arrays", allostat) 
+
+        tag_array(1:atom_num_lr) = tag_atom
+        tag_array(atom_num_lr+1:) = 0
+        call move_alloc(tag_array, tag_atom)
+
+        type_array(1:atom_num_lr) = type_atom
+        type_array(atom_num_lr+1:) = 0
+        call move_alloc(type_array, type_atom)
+
+        mask_array(1:atom_num_lr) = a_mask
+        mask_array(atom_num_lr+1:) = 0
+        call move_alloc(mask_array, a_mask)
+
+        r_array(:,1:atom_num_lr) = r_atom
+        r_array(:,atom_num_lr+1:) = 0.0_wp
+        call move_alloc(r_array, r_atom)
+
+        if(need_vel) then 
+            allocate(vel_array(3,atom_num_lr+grow_by), stat=allostat)
+            if(allostat > 0) call alloc_error("Failed allocating vel_array in grow_at_arrays", allostat)
+            vel_array(:,1:atom_num_lr) = vel_atom
+            vel_array(:,atom_num_lr+1:) = 0.0_wp
+            call move_alloc(vel_array, vel_atom)
+        end if
+        
+        atom_num_lr = atom_num_lr +grow_by
+        return
+    end subroutine grow_at_arrays
+
+    subroutine alloc_cg_arrays
+        !Allocate arrays needed for coarse-grained elements 
+        integer :: allostat
+        
+        if(allocated(tag_ele)) deallocate(tag_ele, size_ele, ele_glob_id, etype, cg_node, cg_atomap, basis_num, basis_type, &
+                                          node_cg, r)  
+        allocate( &
+            tag_ele(ele_num_l), &
+            size_ele(ele_num_l), &
+            ele_glob_id(ele_num_l), &
+            etype(ele_num_l), &
+            e_mask(ele_num_l), &
+            cg_node(ng_max_node, ele_num_l), &
+            cg_atomap(atomap_max, ele_num_l),   &
+            basis_num(ele_num_l), &
+            basis_type(max_basisnum, ele_num_l), &
+            node_cg(node_num_l), &
+            r(3,max_basisnum, node_num_l), &
+            stat=allostat )
+        if (allostat > 0) call alloc_error("Failed allocating cg_arrays", allostat)
+        tag_ele(:) = 0
+        size_ele(:) = 0
+        etype(:) = 0
+        e_mask(:) = 0
+        ele_glob_id(:) = 0
+        cg_node(:,:) =0
+        cg_atomap(:,:) = 0
+        basis_num(:) = 0
+        basis_type(:,:) = 0
+        node_cg(:) = 0
+        r(:,:,:) = 0.0_wp
+
+
+        if(periodic) then 
+            if (allocated(pb_node)) deallocate(pb_node)
+            allocate(pb_node(3, max_basisnum, node_num_l), stat=allostat) 
+            if (allostat > 0) call alloc_error("Failed allcoating pb_node in alloc_cg_arrays", allostat)
+            pb_node(:,:,:) = 0
+        end if
+
+        if(need_vel) then 
+            if (allocated(vel)) deallocate(vel)
+            allocate(vel(3, max_basisnum, node_num_l))
+            if (allostat > 0) call alloc_error("Failed allocating cg vel array", allostat)
+            vel(:,:,:) = 0.0_wp
+        end if
+
+        !Interpolation arrays
+        if(allocated(tag_atomap)) deallocate(tag_atomap, type_atomap, atomap_to_intpo, r_atomap)
+        allocate (&
+            tag_atomap(atomap_num_l),           &
+            type_atomap(atomap_num_l),          &
+            atomap_to_intpo(2, atomap_num_l),   &
+            r_atomap(3, atomap_num_l),          &
+            stat=allostat &
+        )
+
+        if (allostat > 0) call alloc_error("Failed allocating interp_arrays", allostat) 
+        tag_atomap(:) = 0
+        type_atomap = 0
+        atomap_to_intpo = 0
+        r_atomap(:,:) = 0.0_wp
+
+    end subroutine alloc_cg_arrays
+
+    subroutine dealloc_cg_arrays
+        !Deallocate arrays needed for coarse-grained elements 
+        integer :: allostat
+        deallocate( tag_ele, size_ele, ele_glob_id, etype, e_mask, cg_node, cg_atomap, basis_num, basis_type, &
+                  node_cg, r, stat=allostat )
+        if (allostat > 0) call alloc_error("Failed deallocating cg_arrays", allostat)
+        if(periodic) then 
+            deallocate(pb_node, stat=allostat) 
+            if (allostat > 0) call alloc_error("Failed deallcoating pb_node in alloc_cg_arrays", allostat)
+        end if
+
+        if(need_vel) then 
+            deallocate(vel)
+            if (allostat > 0) call alloc_error("Failed deallocating cg vel array", allostat)
+        end if
+
+        !Interpolation arrays
+        deallocate(tag_atomap, type_atomap, r_atomap, atomap_to_intpo, stat=allostat)
+
+        if (allostat > 0) call alloc_error("Failed allocating interp_arrays", allostat) 
+
+        return
+    end subroutine dealloc_cg_arrays
+
+
+    subroutine grow_cg_arrays(opt, seg_real)
+        !This subroutine just grows the element arrays if needed
+
+        !opt is 1 for growing element arrays, 2 for growing node arrays, 3 for growing atomap arrays
+        !seg_real is the growth size, usually compared to 
+        integer, intent(in) :: opt
+        integer, intent(in), optional :: seg_real
+
+        !temp element arrays
+        integer, allocatable ::tag_ele_array(:), size_ele_array(:), etype_array(:), cg_node_array(:,:), basis_num_array(:), &
+        basis_type_array(:,:), cg_atomap_array(:,:), mask_array(:)
+
+        !Temp node arrays
+        integer, allocatable :: node_cg_array(:),  pb_node_array(:,:,:), ele_glob_id_array(:)
+        real(kind=wp), allocatable :: r_array(:,:,:), vel_array(:,:,:)
+
+        !temp atomap arrays 
+        integer, allocatable :: tag_atomap_array(:), type_atomap_array(:), atomap_to_intpo_array(:,:)
+        real(kind=wp), allocatable :: r_atomap_array(:,:)
+
+        integer :: grow_by
+                                 
+        if (present(seg_real)) then
+            grow_by = seg_real
+        else 
+            grow_by = seg_num
+        end if
+
+        if (opt == 1) then 
+            allocate( &
+               tag_ele_array(ele_num_lr+grow_by), &
+               ele_glob_id_array(ele_num_lr+grow_by), &
+               size_ele_array(ele_num_lr+grow_by), &
+               etype_array(ele_num_lr+grow_by), &
+               mask_array(ele_num_lr+grow_by), &
+               cg_node_array(ng_max_node, ele_num_lr+grow_by), &
+               cg_atomap_array(atomap_max, ele_num_lr+grow_by), &
+               basis_num_array(ele_num_lr+grow_by), &
+               basis_type_array(max_basisnum, ele_num_lr+grow_by), &
+               stat=allostat &
+            )
+            if(allostat > 0) call alloc_error("Failed allocation of temp ele arrays in grow_cg_arrays", allostat)
+
+            tag_ele_array(1:ele_num_lr) = tag_ele(:)
+            tag_ele_array(ele_num_lr+1:) = 0
+            call move_alloc(tag_ele_array, tag_ele)
+
+            ele_glob_id_array(1:ele_num_lr) = ele_glob_id(:)
+            ele_glob_id_array(ele_num_lr+1:) = 0
+            call move_alloc(ele_glob_id_array, ele_glob_id)
+
+            size_ele_array(1:ele_num_lr) = size_ele(:)
+            size_ele_array(ele_num_lr+1:) = 0
+            call move_alloc(size_ele_array, size_ele)
+
+            etype_array(1:ele_num_lr) = etype(:)
+            etype_array(ele_num_lr+1:) = 0
+            call move_alloc(etype_array, etype)
+
+            mask_array(1:ele_num_lr) = e_mask
+            mask_array(ele_num_lr+1:)= 0
+            call move_alloc(mask_array, e_mask)
+
+            cg_node_array(:,1:ele_num_lr) = cg_node(:,:)
+            cg_node_array(:,ele_num_lr+1:) = 0
+            call move_alloc(cg_node_array, cg_node)
+
+            cg_atomap_array(:,1:ele_num_lr) = cg_atomap(:,:)
+            cg_atomap_array(:,ele_num_lr+1:) = 0
+            call move_alloc(cg_atomap_array, cg_atomap)
+
+            basis_num_array(1:ele_num_lr) = basis_num(:)
+            basis_num_array(ele_num_lr+1:) = 0
+            call move_alloc(basis_num_array, basis_num)
+
+            basis_type_array(:,1:ele_num_lr) = basis_type(:,:)
+            basis_type_array(:,ele_num_lr+1:) = 0
+            call move_alloc(basis_type_array, basis_type)
+
+            ele_num_lr = ele_num_lr + grow_by
+        else if (opt==2) then 
+            allocate( node_cg_array(node_num_lr + grow_by),    &
+                     r_array(3, max_basisnum, node_num_lr + grow_by), &
+                     stat=allostat)
+
+            node_cg_array(1:node_num_lr) = node_cg
+            node_cg_array(node_num_lr+1:) = 0
+            call move_alloc(node_cg_array, node_cg)
+
+            r_array(:,:,1:node_num_lr) = r(:,:,1:node_num_lr)
+            r_array(:,:,node_num_lr+1:) = 0.0_wp
+            call move_alloc(r_array, r)
+
+            if(need_vel) then 
+                allocate( vel_array(3, max_basisnum, node_num_lr + grow_by), &
+                          stat=allostat)
+
+                if(allostat > 0) call alloc_error("Failure allocating vel in grow_cg_arrays",allostat)
+                vel_array(:,:,1:node_num_lr) = vel(:,:,1:node_num_lr)
+                vel_array(:,:,node_num_lr+1:) = 0.0_wp
+                call move_alloc(vel_array, vel)
+            end if
+
+            if(periodic) then 
+                allocate( pb_node_array(3, max_basisnum, node_num_lr + grow_by), &
+                          stat=allostat)
+                if(allostat > 0) call alloc_error("Failure allocating pb_node in grow_cg_arrays",allostat)
+                pb_node_array(:,:,1:node_num_lr) = pb_node
+                pb_node_array(:,:,node_num_lr+1:) = 0.0_wp
+                call move_alloc(pb_node_array, pb_node)
+            end if
+
+            node_num_lr = node_num_lr + grow_by
+
+        else if(opt==3) then 
+            !Resize atomap arrays
+            allocate(tag_atomap_array(atomap_num_lr + grow_by), &
+                     type_atomap_array(atomap_num_lr + grow_by), &
+                     atomap_to_intpo_array(2, size(atomap_to_intpo,2)+grow_by), &
+                     r_atomap_array(3,atomap_num_lr + grow_by), &
+                     stat = allostat)
+            if(allostat > 0) call alloc_error("Failure allocating temp atomap arrays in grow_cg_arrays", allostat)
+
+            tag_atomap_array(1:atomap_num_lr) = tag_atomap(:)
+            tag_atomap_array(atomap_num_lr+1:) = 0
+            call move_alloc(tag_atomap_array, tag_atomap)
+
+            type_atomap_array(1:atomap_num_lr) = type_atomap(:)
+            type_atomap_array(atomap_num_lr+1:) = 0
+            call move_alloc(type_atomap_array, type_atomap)
+
+            atomap_to_intpo_array = 0
+            atomap_to_intpo_array(:, 1:size(atomap_to_intpo,2)) = atomap_to_intpo
+            call move_alloc(atomap_to_intpo_array, atomap_to_intpo)
+
+            r_atomap_array(:,1:atomap_num_lr) = r_atomap(:,:)
+            r_atomap_array(:,atomap_num_lr+1:) = 0.0_wp
+            call move_alloc(r_atomap_array, r_atomap)
+
+            atomap_num_lr = atomap_num_lr + grow_by
+        end if
+
+        return
+    end subroutine grow_cg_arrays
+
+    subroutine setup_interpolation(max_esize, unique_enum, unique_esize)
+        !This subroutine sets up the interpolation arrays
+        integer, intent(in) :: max_esize, unique_enum
+        integer, dimension(unique_enum), intent(in) :: unique_esize
+
+        integer :: i, ix, iy, iz, esize, iatom
+        real(kind = wp) :: dr, ds, dt
+
+        !First allocate important arrays
+        allocate( a_interpo(maxval(ng_node), atomap_max, unique_enum, defined_element_types), &
+                  size_to_shape(max_esize),  &
+                  shape_sizes(max_esize), &
+                  stat = allostat)
+        if (allostat > 0) call alloc_error("Failed to allocate shape arrays in setup_interpolation", allostat)
+
+        !Save the maximum esize as we need it later
+        max_size = max_esize
+
+        !Now loop over all unique elements. We duplicate the interpolation shape function for all element types, this leads to some
+        !extra memory usage, but it shoudl be small enough to where it doesn't matter
+        size_to_shape(:) = 0
+        unique_sizes = unique_enum
+        a_interpo(:,:,:,:) = 0.0_wp
+        do i = 1, unique_enum
+            esize = unique_esize(i)
+            shape_sizes(i) =unique_esize(i)
+            !size_to_shape maps the element size to the shape function index
+            size_to_shape(esize) = i
+            iatom=0
+            
+            !Cube element shape functions
+            do iz = 1, esize+1
+                dt=-1.0_dp +(iz-1)*(2.0_dp/(esize))   
+                do iy = 1, esize+1
+                    ds=-1.0_dp +(iy-1)*(2.0_dp/(esize))   
+                    do ix = 1, esize+1
+                        dr=-1.0_dp +(ix-1)*(2.0_dp/(esize))   
+                        iatom = iatom + 1
+                        a_interpo(1,iatom,i,1:2) = (1.0_wp-dr)*(1.0_wp-ds)*(1.0_wp-dt)/8.0_wp
+                        a_interpo(2,iatom,i,1:2) = (1.0_wp+dr)*(1.0_wp-ds)*(1.0_wp-dt)/8.0_wp
+                        a_interpo(3,iatom,i,1:2) = (1.0_wp+dr)*(1.0_wp+ds)*(1.0_wp-dt)/8.0_wp
+                        a_interpo(4,iatom,i,1:2) = (1.0_wp-dr)*(1.0_wp+ds)*(1.0_wp-dt)/8.0_wp
+                        a_interpo(5,iatom,i,1:2) = (1.0_wp-dr)*(1.0_wp-ds)*(1.0_wp+dt)/8.0_wp
+                        a_interpo(6,iatom,i,1:2) = (1.0_wp+dr)*(1.0_wp-ds)*(1.0_wp+dt)/8.0_wp
+                        a_interpo(7,iatom,i,1:2) = (1.0_wp+dr)*(1.0_wp+ds)*(1.0_wp+dt)/8.0_wp
+                        a_interpo(8,iatom,i,1:2) = (1.0_wp-dr)*(1.0_wp+ds)*(1.0_wp+dt)/8.0_wp
+                    end do
+                end do
+            end do
+
+            !serendipity 20 node element shape function
+            iatom = 0
+            do iz = 1, esize+1
+                dt = (iz - ((real(esize,wp)/2.0_wp) + 1.0_wp)) / (real(esize,wp) / 2.0_wp)
+                do iy = 1, esize+1
+                    ds = (iy - ((real(esize,wp)/2.0_wp) + 1.0_wp)) / (real(esize,wp) / 2.0_wp)
+                    do ix = 1, esize+1
+                        dr = (ix - ((real(esize,wp) / 2.0_wp) + 1.0_wp)) / (real(esize,wp) / 2.0_wp)
+                        iatom = iatom + 1
+                        
+                        !Corner nodes
+                        a_interpo(1,iatom,i,3) = (1.0_dp-dr)*(1.0_dp-ds)*(1.0_dp-dt)*(-dr-ds-dt-2)/8.0_dp
+                        a_interpo(2, iatom,i,3) = (1.0_dp+dr)*(1.0_dp-ds)*(1.0_dp-dt)*(dr-ds-dt-2)/8.0_dp
+                        a_interpo(3, iatom,i,3) = (1.0_dp+dr)*(1.0_dp+ds)*(1.0_dp-dt)*(dr+ds-dt-2)/8.0_dp
+                        a_interpo(4, iatom,i,3) = (1.0_dp-dr)*(1.0_dp+ds)*(1.0_dp-dt)*(-dr+ds-dt-2)/8.0_dp
+                        a_interpo(5, iatom,i,3) = (1.0_dp-dr)*(1.0_dp-ds)*(1.0_dp+dt)*(-dr-ds+dt-2)/8.0_dp
+                        a_interpo(6, iatom,i,3) = (1.0_dp+dr)*(1.0_dp-ds)*(1.0_dp+dt)*(dr-ds+dt-2)/8.0_dp
+                        a_interpo(7, iatom,i,3) = (1.0_dp+dr)*(1.0_dp+ds)*(1.0_dp+dt)*(dr+ds+dt-2)/8.0_dp
+                        a_interpo(8, iatom,i,3) = (1.0_dp-dr)*(1.0_dp+ds)*(1.0_dp+dt)*(-dr+ds+dt-2)/8.0_dp
+
+                        !Side nodes, first node r is zero
+                        a_interpo(9, iatom,i,3) =  (1-dr*dr)*(1-ds)*(1-dt)/4.0_dp
+                        a_interpo(11, iatom,i,3) = (1-dr*dr)*(1+ds)*(1-dt)/4.0_dp
+                        a_interpo(17, iatom,i,3) = (1-dr*dr)*(1-ds)*(1+dt)/4.0_dp
+                        a_interpo(19, iatom,i,3) = (1-dr*dr)*(1+ds)*(1+dt)/4.0_dp
+
+                        !node s is zero
+                        a_interpo(10, iatom,i,3) = (1+dr)*(1-ds*ds)*(1-dt)/4.0_dp
+                        a_interpo(12, iatom,i,3) = (1-dr)*(1-ds*ds)*(1-dt)/4.0_dp
+                        a_interpo(18, iatom,i,3) = (1+dr)*(1-ds*ds)*(1+dt)/4.0_dp
+                        a_interpo(20, iatom,i,3) = (1-dr)*(1-ds*ds)*(1+dt)/4.0_dp
+
+                        !node t is zero
+                        a_interpo(13, iatom,i,3) = (1-dr)*(1-ds)*(1-dt*dt)/4.0_dp
+                        a_interpo(14, iatom,i,3) = (1+dr)*(1-ds)*(1-dt*dt)/4.0_dp
+                        a_interpo(15, iatom,i,3) = (1+dr)*(1+ds)*(1-dt*dt)/4.0_dp
+                        a_interpo(16, iatom,i,3) = (1-dr)*(1+ds)*(1-dt*dt)/4.0_dp
+
+                    end do
+                end do
+            end do           
+        end do 
+
+        return
+    end subroutine setup_interpolation
+    
+    subroutine dealloc_shape_arrays
+        !this subroutine deallocates shape arrays. Will be needed if element sizes change for some reason.
+        if(allocated(a_interpo)) then 
+            deallocate( a_interpo, size_to_shape, shape_sizes, stat = allostat)
+            if (allostat > 0) call alloc_error("Failed deallocating shape arrays in dealloc_shape_arrays", allostat)
+        end if
+
+    end subroutine
+
+    subroutine interp_atom(iatom, esize, ele_type, pb_in, basisnum, r_nodes, r_iatom)
+        !This subroutine interpolates atom positions based on the iatom number
+        
+        !ARGUMENTS
+        integer, intent(in) :: iatom !Atom to interpolate
+        integer, intent(in) :: esize !Size of element, needed for getting the correct interpolation array
+        integer, intent(in) :: ele_type
+        integer, dimension(3, max_basisnum, ng_max_node), intent(in) :: pb_in !Periodic boundary info
+        integer, intent(in) :: basisnum !Number of basis atoms at nodes
+        real(kind=wp), dimension(3, max_basisnum, ng_max_node), intent(in) :: r_nodes !Contiguous array of nodal positions
+        real(kind=wp), dimension(3,max_basisnum), intent(out) :: r_iatom !Position of all interpolated atoms at lat point
+        
+        !INTERNAL VARIABLES 
+        integer :: inod, ibasis, info(3), node_num
+        real(kind=wp) :: rout(3), shape_fun(ng_node(ele_type))
+        logical :: ipb, ip_change(max_basisnum,ng_node(ele_type))
+
+        node_num = ng_node(ele_type)
+        !Initialization
+        r_iatom(:,:) = 0.0_wp    
+        ipb =.false.
+        ip_change(:,:) = .false.
+        shape_fun = a_interpo(1:node_num, iatom, size_to_shape(esize), ele_type)
+
+        do inod = 1, node_num
+            do ibasis = 1, basisnum
+                !Figure out periodic boundaries for the nodes
+                rout=r_nodes(:,ibasis, inod)
+                if(periodic) then 
+                    !Restore periodic boundaries if needed
+                    call restore_pb(rout, pb_in(:,ibasis,inod), ipb)
+                    ip_change(ibasis,inod) = ipb
+                end if
+
+                r_iatom(:,ibasis) = r_iatom(:,ibasis) + rout*shape_fun(inod)
+            end do 
+        end do
+
+        !Now apply periodic boundaries if needed
+        
+        if(any(ip_change)) then 
+            do ibasis = 1, basisnum
+                call cross_pb(r_iatom(:,ibasis), info)
+                if(.not. in_box_bd(r_iatom(:, ibasis))) then 
+                    call bounds_error("Atom incorrectly interpolated", r_iatom, box_bd)
+                end if
+            end do
+        end if
+
+        return
+    end subroutine interp_atom
+
+
+
+    subroutine update_virtual_atoms(update_all)
+        !This subroutine updates the virtual atoms from nodal positions
+        logical, intent(in) :: update_all
+
+        integer :: ie, virt_count, iatom, ibasis, jatomap, iatomap, inod, ip, pb_in(3, max_basisnum, ng_max_node)
+        real(kind = wp) :: r_interp(3, max_basisnum), r_nodes(3, max_basisnum, ng_max_node)
+
+        !Loop over all atoms
+        jatomap = 0
+        do ie = 1, ele_num_l
+            select case(etype(ie))
+            case(1,2,3)
+                virt_count = (size_ele(ie)+1)**3    
+            end select
+
+            !Get the nodal values into a connected array
+            r_nodes(:,:,:) = 0.0_wp
+            pb_in(:,:,:) = 0
+            do inod = 1, ng_node(etype(ie))
+                ip = cg_node(inod, ie)
+                r_nodes(:,:,inod) = r(:,:,ip)
+                if(periodic) pb_in(:,:,inod) = pb_node(:,:,ip)
+            end do
+            
+            do iatom = 1, virt_count
+
+                !interpolate the atoms
+                call interp_atom(iatom, size_ele(ie), etype(ie), pb_in, basis_num(ie), r_nodes, r_interp)
+                do ibasis = 1, basis_num(ie)
+                    !Now get the real atom position
+                    iatomap=cg_atomap(basis_num(ie)*(iatom-1) + ibasis, ie) 
+
+                    if(iatomap /= 0) then 
+                        jatomap = jatomap+1
+                        !This just checks to make sure that the cg_atomap is sorted, ie the first virtual atom we have 
+                        ! is first in r_atomap and the second is second etc.
+                        if(iatomap /= jatomap) then
+                            print *, "Error: Iatomap", iatomap, " should equal", jatomap
+                            call mpi_abort(mpi_comm_world, 1, ierr)
+                        end if
+                        
+                        r_atomap(:,iatomap) = r_interp(:,ibasis)
+                    end if
+                end do
+            end do
+        end do
+        return
+    end subroutine update_virtual_atoms
+
+    pure function get_virtual_count(et, esize)
+        !Return the number of virtual lattice points 
+        integer, intent(in) :: et, esize
+        integer :: get_virtual_count
+
+        select case(et)
+        case(1,2,3)
+            get_virtual_count = (esize+1)**3
+        end select
+        return
+    end function get_virtual_count
+
+    subroutine x2frac
+        !This subroutine changes r arrays to be fractional coordinates
+
+        integer :: i, j, ibasis
+
+        do i = 1, atom_num_l
+            do j = 1,3 
+                r_atom(j, i) = (r_atom(j,i)-box_bd(2*j-1))/(box_length(j))
+            end do
+        end do
+
+        do i = 1, node_num_l
+            do ibasis= 1, basis_num(node_cg(i))
+                do j = 1, 3
+                    r(j, ibasis,  i) = (r(j,ibasis,i)-box_bd(2*j-1))/(box_length(j))
+                end do
+            end do
+        end do
+        return
+    end subroutine x2frac
+
+    subroutine frac2x
+        !This subroutine changes the fractional coordinates back to real coordinates
+        integer :: i, j, ibasis
+
+        do i = 1, atom_num_l
+            do j = 1,3 
+                r_atom(j,i) =  r_atom(j,i)*box_length(j) + box_bd(2*j-1)
+            end do
+        end do
+
+        do i = 1, node_num_l
+            do ibasis= 1, basis_num(node_cg(i))
+                do j = 1, 3
+                    r(j,ibasis,i) =  r(j, ibasis, i)*box_length(j) + box_bd(2*j-1)
+                end do
+            end do
+        end do
+        return
+    end subroutine frac2x
+
+end module elements

src/errors.f90

@@ -0,0 +1,73 @@
+module errors
+    !This subroutines is in charge of handling error strings and exiting the application
+    use mpi
+    use parameters
+    use logger
+
+    implicit none 
+    public 
+    contains
+
+    subroutine alloc_error(error_string, allostat)
+        integer, intent(in) :: allostat
+        character(len=*), intent(in) :: error_string
+        character(len=read_len) :: msg
+        
+        write(msg, *) "Allocate Error: ", trim(adjustl(error_string)), " with allostat ", allostat
+        call exit_error(msg)
+        return
+    end subroutine alloc_error
+
+   subroutine bounds_error(error_string, r, bounds)
+        !Atom unexpectedly outside boundary, usually box boundary
+        real(kind=wp), intent(in) :: r(3), bounds(6)
+        character(len=*), intent(in) :: error_string
+        character(len=read_len) :: msg
+
+        write(msg,*) "Bounds Error: ", trim(adjustl(error_string)), " for position ", r, " and bounds", bounds
+        call exit_error(msg)
+        return
+    end subroutine bounds_error
+
+    subroutine read_error(error_string, stat)
+        !Error when parsing string
+        character(len = *), intent(in) :: error_string
+        integer, intent(in) :: stat
+        character(len=read_len) :: msg
+        
+        write(msg,*) "Read Error: ", trim(adjustl(error_string)), " with stat ", stat
+        call exit_error(msg)
+        return
+    end subroutine read_error
+
+    subroutine misc_error(error_string)
+        !Misc_error
+        character(len=*), intent(in) :: error_string
+        character(len=read_len) :: msg
+
+        write(msg,*) "Error: ", trim(adjustl(error_string))
+        call exit_error(msg)
+        return
+    end subroutine misc_error
+
+    subroutine command_error(error_string)
+        !Error with incorrect command 
+        character(len = *) :: error_string
+        character(len=read_len) :: msg
+
+        write(msg,*) "Command Error: ", trim(adjustl(error_string))
+        call exit_error(msg)
+        return 
+    end subroutine command_error
+
+    subroutine exit_error(msg)
+        !Exit code with error
+        character(len=*), intent(in) :: msg
+
+        call log_msg(msg, 0, .true.)
+        call close_log
+        call mpi_abort(mpi_comm_world, 1, ierr)
+        return
+    end subroutine exit_error
+
+end module errors

src/fire.f90

@@ -0,0 +1,284 @@
+module fire 
+
+    use parameters
+    use comms
+    use elements 
+    use forces  
+    use time
+    use atom_types
+    use neighbors
+    use potential
+    use debug
+    
+    implicit none
+
+    real(kind=wp), private, save :: tmax, tmin, dtgrow, dtshrink, alpha0, alphashrink, alpha, last_negative, dmax, &
+                                    dtmax, dtmin
+    integer, private, save :: delaystep, vdfmax, vdotf_negatif, neval
+    logical, private, save :: initialdelay, flagv0
+
+   real(kind = wp), parameter :: &
+     f_inc_fire = 1.1_wp, &
+     f_dec_fire = 0.5_wp, &
+     f_alpha_fire = 0.99_wp, &
+     alpha_start_fire = 0.1_wp
+
+    real(kind=wp), save :: alpha_fire
+
+
+    public 
+    contains
+
+    subroutine fire_defaults
+        !This sets the default parameters for fire. These are taken from the default parameters used in lammps
+        !Presented in https://doi.org/10.1016%2Fj.commatsci.2020.109584
+        !Max timstep is tmax x delta t_start
+        tmax = 10.0_wp
+        !Minimum timestep is tmin x delta t_start
+        tmin = 0.02_wp
+        !Number of steps to wait after P<0 before increasing deltat
+        delaystep = 20
+        !Factor by which del t increases/decrases
+        dtgrow = 1.1_wp
+        dtshrink = 0.5_wp
+        !Coefficient for mixing velocity and force vectors and the factor by which it decreases
+        alpha0 = 0.25_wp
+        alpha = alpha0
+        alphashrink = 0.99_wp
+        !Exit after vdfmax consecutive iterations with P(t) < 0
+        vdfmax = 2000 !Inertia correction halfstepback = .true.  activates initial delay in modifying delta t and alpha
+        initialdelay = .true.
+        dmax = 0.1
+
+    end subroutine fire_defaults
+
+    subroutine set_fire_param(param, val)
+        character(len=*), intent(in) :: param
+        real(kind=wp), intent(in) :: val
+
+        select case(param)
+        case('alpha0')
+            alpha0=val
+        case('tmax')
+            tmax=val
+        case('tmin')
+            tmin=val
+        end select
+
+    end subroutine set_fire_param
+
+    subroutine fire_init
+        !Initialize fire variables
+        last_negative = 0
+        vdotf_negatif = 0
+        flagv0=.true.
+        neval = 0
+        alpha = alpha0
+        dtmax = tmax*time_step
+        dtmin = tmin*time_step
+    end subroutine fire_init
+
+    subroutine fire_iterate(i, code)
+        integer, intent(in) :: i
+        integer, intent(out) :: code
+
+        integer :: ie, ibasis, ip, ia
+        real(kind= wp) :: vdotfme, vdotfall, vdotvme, vdotvall, fdotfme, fdotfall, scale1, scale2, dtf, dtfm, &
+                          dtvone, vmax, dtv
+        logical :: delayflag
+
+        !First calculate vdotfall 
+        vdotfme = 0.0_wp
+        code=0
+        do ip = 1, node_num_l
+            ie = node_cg(ip)
+            if(who_has_ele(ie)) then 
+                do ibasis = 1, basis_num(ie)
+                    !We multiply by the energy of all virtual atoms for the energy, which is force_eq times the nodal mass
+                    vdotfme = vdotfme + vel(1,ibasis,ip)*force_eq(1,ibasis,ip)+vel(2,ibasis,ip)*force_eq(2,ibasis,ip)  &
+                                                 + vel(3,ibasis,ip)*force_eq(3,ibasis,ip)
+                end do
+            end if
+        end do
+        do ia = 1, atom_num_l
+            vdotfme = vdotfme + force_atom(1,ia)*vel_atom(1,ia) + force_atom(2,ia)*vel_atom(2,ia) &
+                              + force_atom(3,ia)*vel_atom(3,ia)
+        end do
+        call mpi_allreduce(vdotfme, vdotfall, 1, mpi_wp, mpi_sum, world, ierr)
+
+
+        !if (v dot f) > 0:
+        !v = (1-alpha) v + alpha |v| Fhat
+        !|v| = length of v, Fhat = unit f
+        !Only: (1-alpha) and alpha |v| Fhat is calculated here
+        !the modificatin of v is made within the integration, after v update
+        !if more than delaystep since v dot f was negative:
+        !increase timestep, update global timestep and decrease alpha
+        if (vdotfall > 0) then 
+            vdotvme = 0.0_wp
+            fdotfme = 0.0_wp
+            vdotf_negatif = 0
+            do ip = 1, node_num_l
+                ie = node_cg(ip)
+                if (who_has_ele(ie)) then 
+                    do ibasis = 1, basis_num(ie)
+                        !We multiply by the force/velocity of all virtual atoms for the energy, which is force_eq times the nodal mass
+                        vdotvme = vdotvme + vel(1,ibasis,ip)*vel(1,ibasis,ip)+vel(2,ibasis,ip)*vel(2,ibasis,ip) &
+                                                     + vel(3,ibasis,ip)*vel(3,ibasis,ip)
+
+                        fdotfme = fdotfme + force_eq(1,ibasis,ip)*force_eq(1,ibasis,ip) &
+                                          + force_eq(2,ibasis,ip)*force_eq(2,ibasis,ip) & 
+                                          + force_eq(3,ibasis,ip)*force_eq(3,ibasis,ip)
+                        
+                    end do
+                end if
+            end do
+            do ia = 1, atom_num_l
+                vdotvme = vdotvme + vel_atom(1,ia)*vel_atom(1,ia) + vel_atom(2,ia)*vel_atom(2,ia) &
+                                  + vel_atom(3,ia)*vel_atom(3,ia)
+                fdotfme = fdotfme + force_atom(1,ia)*force_atom(1,ia) + force_atom(2,ia)*force_atom(2,ia) &
+                                  + force_atom(3,ia)*force_atom(3,ia)
+            end do
+            call mpi_allreduce(vdotvme, vdotvall, 1, mpi_wp, mpi_sum, world, ierr)       
+            call mpi_allreduce(fdotfme, fdotfall, 1, mpi_wp, mpi_sum, world, ierr)       
+            
+            !Calculate scaling factors
+            scale1 = 1.0 - alpha
+            if(fdotfall <= 1d-20) then 
+                scale2 = 0.0_wp
+            else 
+                scale2 = alpha * sqrt(vdotvall/fdotfall)
+            end if
+
+            if(i - last_negative > delaystep) then 
+                time_step = min(time_step*dtgrow, dtmax)
+                alpha = alpha * alphashrink
+            end if
+        else
+            last_negative = i
+            delayflag = .true.
+            if ((i - 1 < delaystep).and.initialdelay) delayflag = .false.
+            if(delayflag) then 
+                alpha = alpha0
+                if(time_step*dtshrink >= dtmin) time_step = time_step * dtshrink
+            end if
+            
+            !Check stopping criterion
+            vdotf_negatif = vdotf_negatif + 1
+            if ((vdfmax > 0).and.(vdotf_negatif > vdfmax)) then 
+                code = 3
+                return
+            end if
+
+            !Apply intertia correcection
+            do ip = 1, node_num_l
+                do ibasis = 1, basis_num(ie)
+                    r(:,ibasis, ip) = r(:, ibasis, ip) - 0.5_wp*time_step*vel(:,ibasis,ip)
+                end do
+            end do
+            do ia = 1, atom_num_l
+                r_atom(:,ia) = r_atom(:, ia) - 0.5_wp*time_step*vel_atom(:,ia)
+            end do
+
+            !Zero velocities
+            if(node_num_l > 0) vel(:,:,:) = 0.0_wp
+            if(atom_num_l > 0 ) vel_atom(:,:) = 0.0_wp
+            flagv0 = .true.
+        end if
+
+        !Evaluate velocity to determine whether dtv has to be limited. Required when v is reset
+        if(flagv0) then 
+            dtf = time_step*ftm2v
+            call update_neighbor(iter)
+            call update_force
+            neval = neval + 1 
+            do ip = 1, node_num_l
+                ie = node_cg(ip)
+                do ibasis = 1, basis_num(ie)
+                    dtfm = dtf/masses(basis_type(ibasis,ie))
+                    vel(:,ibasis, ip)  = dtfm * force_eq(:, ibasis, ip)
+                end do
+            end do
+            do ia = 1, atom_num_l
+                dtfm = dtf/masses(type_atom(ia))
+                vel_atom(:,ia) = dtfm*force_atom(:,ia)
+            end do           
+        end if
+
+        !Limit timestep so no particle moves further than dmax
+        dtvone = time_step
+        do ip = 1, node_num_l
+            if(who_has_ele(node_cg(ip))) then 
+                vmax = maxval(vel(:,:,ip))
+                if(dtvone*vmax > dmax) dtvone = dmax/vmax
+            end if
+        end do
+        do ia = 1, atom_num_l
+            vmax = maxval(vel_atom(:,ia))
+            if(dtvone*vmax > dmax) dtvone = dmax/vmax
+        end do           
+        call mpi_allreduce(dtvone, dtv, 1, mpi_wp, mpi_min, world, ierr)
+
+        !Reset velocities if necessary
+        if(flagv0) then 
+            if(node_num_l > 0) vel(:,:,:) = 0.0_wp
+            if(atom_num_l > 0) vel_atom(:,:) = 0.0_wp
+        end if
+        
+        !Now do the integration step, this is the lammps default semi-implicit Euler scheme
+
+        dtf =  dtv * ftm2v 
+         do ip = 1, node_num_l
+            do ibasis = 1, basis_num(node_cg(ip))
+                dtfm = dtf/masses(basis_type(ibasis,node_cg(ip)))
+                vel(:,ibasis, ip)  = vel(:, ibasis, ip) + dtfm * force_eq(:, ibasis, ip)
+                if (vdotfall > 0.0_wp) vel(:,ibasis,ip) = scale1*vel(:,ibasis,ip) + scale2*force_eq(:,ibasis,ip)
+                r(:,ibasis,ip) = r(:, ibasis, ip) + dtv*vel(:, ibasis,ip)
+            end do
+        end do
+
+        do ia = 1, atom_num_l
+            dtfm = dtf/masses(type_atom(ia))
+            vel_atom(:,ia) = vel_atom(:,ia) + dtfm*force_atom(:,ia)
+            if(vdotfall > 0.0_wp) vel_atom(:,ia) = scale1*vel_atom(:,ia) + scale2*force_atom(:,ia)
+            r_atom(:,ia) = r_atom(:,ia) + dtv*vel_atom(:,ia)
+        end do                  
+
+        call update_neighbor(iter)
+        call update_force
+
+        neval = neval + 1
+!        do ip = 1, node_num_l
+!            do ibasis = 1, basis_num(ie)
+!                dtfm = dtf/masses(basis_type(ibasis,ie))
+!                vel(:,ibasis, ip)  = vel(:, ibasis, ip) + dtfm * force_eq(:, ibasis, ip)
+!            end do
+!        end do
+!        do ia = 1, atom_num_l
+!            dtfm = dtf/masses(type_atom(ia))
+!            vel_atom(:,ia) = vel_atom(:,ia) + dtfm*force_atom(:,ia)
+!        end do                  
+
+        !Set the velocity evaluation flog 
+        flagv0 = .false.
+
+    end subroutine fire_iterate
+
+    pure function get_fire_delaystep()
+        integer :: get_fire_delaystep
+
+        get_fire_delaystep = delaystep
+        return
+    end function
+
+    pure function get_fire_neval()
+        integer :: get_fire_neval
+
+        get_fire_neval = neval
+        return
+    end function
+
+    subroutine fire_clean
+        time_step = orig_time_step
+    end subroutine fire_clean
+end module

src/force_mod.f90

@@ -0,0 +1,196 @@
+module force_mod 
+    use forces
+    use parameters
+    use elements
+    use group
+    use str
+    use time
+
+    implicit none
+
+    integer, parameter, private :: max_force = 20
+    integer :: set_force_num, add_force_num
+
+    integer, private :: force_group(max_force), add_force_group(max_force), add_force_every(max_force)
+    logical, private :: force_mask(3, max_force), add_force_mask(3, max_force), add_force_norm(max_force), &
+                        first_add(max_force)
+    real(kind=wp), private :: fvec(3, max_force), add_f(3, max_force)
+
+    public 
+    contains
+
+    subroutine init_set_force
+        set_force_num = 0
+        force_group = 0
+        force_mask = .false.
+        first_add = .false.
+        fvec = 0.0_wp
+    end subroutine
+
+    subroutine init_add_force
+        add_force_num = 0
+        add_force_group = 0
+        add_force_mask = .false.
+        add_force_every(:) = 0
+        add_f  = 0.0_wp
+    end subroutine init_add_force
+
+    subroutine parse_set_force(line)
+        !This subroutine parses the set_force command
+        character(len = *), intent(in) :: line
+        character(len=read_len) :: tmptxt, g, txtvec(3)
+        integer :: iospara, i
+
+        set_force_num = set_force_num + 1
+        first_add(set_force_num) = .true.
+        read(line, *, iostat=iospara) tmptxt, g, (txtvec(i), i = 1, 3)
+        if(iospara > 0) call read_error("Failure to read set_force command", iospara)
+
+        !Get group number
+        force_group(set_force_num) = get_group_index(g)
+        if(force_group(set_force_num) == 0) then 
+            call misc_error("Group "//trim(adjustl(g))// " in set_force command has not been defined. "// &
+                            "Please define group before use")
+        end if
+
+        !Read force_vec and force_mask
+        do i =1, 3
+            call to_lower(txtvec(i))
+            if(.not.(txtvec(i) == 'null')) then 
+                force_mask(i, set_force_num) = .true.
+                read(txtvec(i), *, iostat = iospara) fvec(i, set_force_num)
+                if(iospara > 0) call read_error("Failure to read force vector component "//trim(adjustl(txtvec(i))), iospara)
+            end if
+        end do
+
+    end subroutine parse_set_force
+
+    subroutine parse_add_force(line)
+        character(len=*), intent(in) :: line
+        character(len=read_len) :: tmptxt, g, txtvec(3), extra_commands(20), msg
+        integer :: iospara, i, j
+
+        add_force_num = add_force_num + 1
+        read(line, *, iostat=iospara) tmptxt, g, (txtvec(i), i = 1, 3)
+        if(iospara > 0) call read_error("Failure to read add_force command", iospara)
+
+        !Get group number
+        add_force_group(add_force_num) = get_group_index(g)
+        if(add_force_group(add_force_num) == 0) then 
+            call misc_error("Group "//trim(adjustl(g))// " in add_force command has not been defined. "// &
+                            "Please define group before use")
+        end if
+
+        !Read force_vec and force_mask
+        do i =1, 3
+            call to_lower(txtvec(i))
+            if(.not.(txtvec(i) == 'null')) then 
+                add_force_mask(i, add_force_num) = .true.
+                read(txtvec(i), *, iostat = iospara) add_f(i, add_force_num)
+                if(iospara > 0) call read_error("Failure to read force vector component "//trim(adjustl(txtvec(i))), iospara)
+            end if
+        end do
+
+        !Now get parse any extra optional commands
+        j = tok_count(line)-5
+        if( j > 0) then 
+            read(line, *, iostat=iospara, iomsg=msg) (tmptxt, i = 1, 5), (extra_commands(i), i = 1, j)
+            i = 1
+            do while (i<=j)
+                select case(extra_commands(i))
+                case('every')
+                    i = i+1
+                    read(extra_commands(i), *, iostat=iospara, iomsg=msg) add_force_every(add_force_num)
+                    if(iospara>0) call read_error(msg, iospara)
+                case('norm')
+                    add_force_norm(add_force_num) = .true.
+                end select
+                i=i+1
+            end do
+        end if
+
+    end subroutine parse_add_force
+
+    subroutine add_force
+
+        integer :: i, ip, ia, ie, j
+        real(kind=wp) :: f(3)
+        logical :: do_now
+        
+        do i = 1, add_force_num
+            !Check to see if we need to add force now
+            do_now = .false.
+            if(first_add(i)) then 
+                do_now = .true.
+                first_add(i) = .false.
+            else if(add_force_every(i) == 0) then 
+                do_now = .false.
+            else if (mod(iter, add_force_every(i)) == 0) then 
+                do_now = .true.
+            end if
+
+            if (do_now) then 
+                f = add_f(:,i)
+                !Check to see if the force is normalized, if so make sure the group contains only atoms
+                if(add_force_norm(i)) then 
+                    if(group_counts(2,add_force_group(i)) > 0) then 
+                        call command_error("Currently cannot normalize force when addforce is used on a group containing elements")
+                    end if
+                    if(group_counts(1, add_force_group(i)) >0) then 
+                        f(:) = f(:)/group_counts(1,add_force_group(i))
+                    else
+                        f=0.0_wp
+                    end if
+                end if
+                do ia = 1, atom_num_l
+                    if(btest(a_mask(ia), add_force_group(i))) then 
+                        do j = 1, 3
+                            if (add_force_mask(j, i)) then 
+                                force_atom(j,ia) = force_atom(j,ia) + f(j)
+                            end if
+                        end do
+                    end if
+                end do 
+                do ip = 1, node_num_l
+                    ie = node_cg(ip)
+                    if(btest(e_mask(ie),add_force_group(i))) then 
+                        do j = 1, 3
+                            if (add_force_mask(j,i)) then 
+                                force_eq(j,:, ip) = force_eq(j,:,ip) + f(j)
+                            end if
+                        end do
+                    end if
+                end do  
+            end if
+        end do
+        
+    end subroutine
+
+    subroutine run_set_force
+        integer :: i, j, ia, ip, ie
+
+        do i = 1, set_force_num
+            do ia = 1, atom_num_l
+                if(btest(a_mask(ia), force_group(i))) then 
+                    do j = 1, 3
+                        if (force_mask(j, i)) then 
+                            force_atom(j,ia) = fvec(j,i)
+                        end if
+                    end do
+                end if
+            end do 
+            do ip = 1, node_num_l
+                ie = node_cg(ip)
+                if(btest(e_mask(ie),force_group(i))) then 
+                    do j = 1, 3
+                        if (force_mask(j,i)) then 
+                            force_eq(j,:, ip) = fvec(j,i)
+                        end if
+                    end do
+                end if
+            end do
+        end do
+
+    end subroutine run_set_force
+
+end module force_mod

src/forces.f90

@@ -0,0 +1,330 @@
+module forces
+    !This module is in charge of calculating energy, force, and virial
+
+    use parameters
+    use elements
+    use integration
+
+    implicit none
+
+    real(kind = wp) :: energy_sum, energy_atom_sum, energy_tally, f_norm_tally, energy_equiv_tally
+    !Atom arrays
+    real(kind = wp), allocatable :: energy_atom(:), force_atom(:,:), force_atom_pre(:,:), virial_atom(:,:,:)
+
+    !Element arrays
+    real(kind=wp), allocatable :: energy(:,:), energy_eq(:,:), &
+                                  force(:,:,:), force_eq(:,:,:), force_eq_pre(:,:,:), &
+                                  virial(:,:,:,:), virial_eq(:,:,:,:)
+    logical :: need_force_pre
+
+    public 
+    contains
+
+    subroutine alloc_force_arrays
+        if(atom_num > 0) then 
+            if( allocated(force_atom)) then 
+                deallocate(energy_atom, force_atom, virial_atom, stat=allostat)
+                if (allostat > 0) call alloc_error("Failure to deallocate force_atom arrays", allostat)
+            end if
+            allocate(energy_atom(atom_num_l), force_atom(3, atom_num_l), &
+                     virial_atom(3,3,atom_num_l), stat=allostat)                
+            if (allostat > 0) call alloc_error("Failure to allocate force_atom arrays", allostat)
+        end if
+        if(ele_num> 0) then 
+            if(allocated(force_eq)) then 
+                deallocate(force_eq, energy_eq, virial_eq, stat=allostat) 
+                if (allostat > 0) call alloc_error("Failure deallocating eq arrays", allostat)
+            end if
+            allocate(force_eq(3, max_basisnum, node_num_l), energy_eq(max_basisnum, node_num_l), &
+                     virial_eq(3, 3, max_basisnum, node_num_l), stat = allostat) 
+            if (allostat > 0) call alloc_error("Failure allocating init_force_arrays", allostat)
+        end if
+    end subroutine alloc_force_arrays
+
+    subroutine alloc_pre_array
+        if(atom_num > 0) then 
+            allocate(force_atom_pre(3, atom_num_lr))
+        end if
+        if(ele_num>0) then 
+            allocate(force_eq_pre(3, max_basisnum, node_num_lr))
+        end if
+    end subroutine alloc_pre_array
+
+    subroutine resize_force_arrays
+        !Resize the force arrays to match the node number
+        real(kind=wp), allocatable :: force_pre_array(:,:,:), force_atom_array(:,:)
+        
+        call alloc_force_arrays
+        !Force_eq_pre is the only array that we have to preserve data for because the other ones update prior to use
+        if(need_force_pre) then 
+            if(ele_num > 0) then 
+                allocate(force_pre_array(3,max_basisnum, node_num_l), stat = allostat)
+                if(allostat > 0) call alloc_error("Failure to allocate force_pre_array", allostat)
+                force_pre_array = force_eq_pre(:, :, 1:node_num_l)
+                call move_alloc(force_pre_array, force_eq_pre)
+            end if
+
+            if(atom_num > 0) then 
+                allocate(force_atom_array(3,atom_num_l), stat = allostat)
+                if(allostat > 0) call alloc_error("Failure to allocate force_atom_array", allostat)
+                force_atom_array = force_atom_pre(:,1:atom_num_l) 
+                call move_alloc(force_atom_array, force_atom_pre)
+            end if
+        end if
+
+    end subroutine resize_force_arrays
+
+    subroutine update_equiv
+        !This subroutine calculates the normalized nodal quantities (referred to here as the equivalent)
+        integer :: ie, ip, i, j, je, inod, jnod, ibasis, ind
+        real(kind = wp), allocatable :: force_array(:), force_buff(:), virial_array(:), virial_buff(:), &
+                                        energy_array(:), energy_buff(:)
+
+
+
+
+        !If we have more than one processor than we need to share all this information for all elements that share data
+        if(pro_num > 1) then
+            allocate(force_array(3*ng_max_node*ele_shared_num*max_basisnum), &
+                     energy_array(ng_max_node*ele_shared_num*max_basisnum), stat = allostat)
+            if(allostat /= 0) call alloc_error("Failure to allocate force/energy_array in update_equiv", allostat)
+
+            force_array(:) = 0.0_wp
+            energy_array(:) = 0.0_wp
+
+            if(need_virial) then
+                allocate(virial_array(9*ng_max_node*ele_shared_num*max_basisnum), stat = allostat)
+                if(allostat /= 0) call alloc_error("Failure to allocate virial_array in update_equiv", allostat)
+                virial_array(:) = 0.0_wp
+            end if
+
+            !Assign the buffers for reducing to calculate the equivalent forces. 
+            !The buffer will have empty space so the communications aren't completely 
+            !efficient memory wise but it shouldn't cause very bad slowdowns.
+            do ie = 1, ele_num_l
+                je = ele_id_shared(ie)
+
+                if(je /= 0) then
+                    do inod = 1, ng_node(etype(ie))
+                        ip = cg_node(inod, ie)
+                        do ibasis = 1, basis_num(ie)
+
+                            !Calculate the current index  and put the force, virial, and energy into the send arrays
+                            ind = 3*ng_max_node*max_basisnum*(je-1) + 3*max_basisnum*(inod-1) + 3*(ibasis-1)
+                            do i = 1, 3
+                                if(ind + i > 3*ng_max_node*ele_shared_num*max_basisnum) then
+                                    print *, 'Error: Index of force_array', &
+                                             ind+i, ' is larger than', &
+                                             ' array size', 3*ng_max_node*ele_shared_num*max_basisnum
+                                    call mpi_abort(mpi_comm_world, 1, ierr)
+                                end if
+
+                                force_array(ind+i) = force(i, ibasis, ip)
+
+                                if(need_virial) then
+                                    do j = 1, 3
+                                        if(3*ind + 3*(i-1)+j > 9*ng_max_node*ele_shared_num*max_basisnum) then
+                                            print *, 'Error: Index of virial_array', &
+                                                      3*ind + 3*(i-1)+j, ' is larger than', &
+                                                     ' array size', 9*ng_max_node*ele_shared_num
+                                            call mpi_abort(mpi_comm_world, 1, ierr)
+                                        end if
+                                        virial_array(3*ind+3*(i-1)+j) = virial(j, i, ibasis, ip)
+                                    end do
+                                end if
+                            end do
+
+                            if(ng_max_node*max_basisnum*(je-1)+max_basisnum*(inod-1)+ibasis &
+                                > ng_max_node*ele_shared_num*max_basisnum) then
+                                print *, 'Error: Index of energy_array', &
+                                          ng_max_node*(je-1)+max_basisnum*(inod-1)+ibasis, ' is larger than', &
+                                         ' array size', ng_max_node*ele_shared_num*max_basisnum
+                                call mpi_abort(mpi_comm_world, 1, ierr)
+
+                            end if
+                            energy_array(ng_max_node*max_basisnum*(je-1)+max_basisnum*(inod-1)+ibasis) = energy(ibasis, ip)
+                        end do
+                    end do
+                end if
+            end do
+
+            !allocate force_buff, virial_buff, and energy_buff
+            allocate(force_buff(3*ng_max_node*ele_shared_num*max_basisnum), &
+                     energy_buff(ng_max_node*ele_shared_num*max_basisnum), stat = allostat)
+            if(allostat /= 0) call alloc_error("Failure to allocate force/energy_buff in update_equiv", allostat)
+
+            !Reduce all force_buff, energy_buff, and virial_buff
+            force_buff(:) = 0.0_wp
+            call mpi_allreduce(force_array, force_buff, 3*ng_max_node*ele_shared_num*max_basisnum, &
+                               mpi_wp, mpi_sum, world, ierr)
+
+            energy_buff(:) = 0.0_wp
+            call mpi_allreduce(energy_array, energy_buff, ng_max_node*ele_shared_num*max_basisnum, &
+                               mpi_wp, mpi_sum, world, ierr)
+
+            if(need_virial) then
+                allocate(virial_buff(9*ng_max_node*ele_shared_num*max_basisnum), stat = allostat) 
+                if(allostat /= 0) call alloc_error("Failure to allocate virial_buff in update_equiv", allostat)
+
+                virial_buff(:) = 0.0_wp
+                call mpi_allreduce(virial_array, virial_buff, 9*ng_max_node*ele_shared_num*max_basisnum, &
+                                   mpi_wp, mpi_sum, world, ierr)
+            end if
+
+            !update local energy_eq, force_eq, virial_eq from the buff received from all processors
+            do ie = 1, ele_num_l
+                je = ele_id_shared(ie)
+                if(je /= 0) then
+                  do inod = 1, ng_node(etype(ie))
+
+                    ip = cg_node(inod, ie)
+
+                    do ibasis = 1, basis_num(ie)
+
+                      ind = 3*ng_max_node * max_basisnum * (je-1) + 3*(inod-1)*max_basisnum + 3*(ibasis-1)
+
+                      do i = 1, 3
+                        force(i, ibasis, ip) = force_buff(ind+i)
+
+                        if(need_virial) then
+                            do j = 1, 3
+                                virial(j, i, ibasis, ip) = virial_buff(3*ind + 3*(i-1)+j)
+                            end do
+                        end if
+                      end do
+                      energy(ibasis, ip) = energy_buff(ng_max_node*max_basisnum*(je-1)+max_basisnum*(inod-1) + ibasis)
+                    end do
+                  end do
+                end if
+            end do
+        end if
+
+        !Reset values for eq arrays
+        force_eq(:, :, :) = 0.0_wp
+        if(need_virial) then
+            virial_eq(:, :, :, :) = 0.0_wp
+        end if
+        energy_eq(:, :) = 0.0_wp
+
+        do ie = 1, ele_num_l
+
+            do inod = 1, ng_node(etype(ie))
+
+                ip = cg_node(inod, ie)
+
+                select case(mass_mat_ty) 
+                case('lumped')
+                    !Calculate equivalent values by dividing by the lumped mass matrix
+                    do ibasis = 1, basis_num(ie)
+                        force_eq(:,ibasis, ip) = force(:,ibasis, ip)/mass_mat_coeff(size_ele(ie), etype(ie))
+                        if(need_virial) then
+                            virial_eq(:, :, ibasis, ip) = virial(:, :, ibasis, ip) / mass_mat_coeff(size_ele(ie), etype(ie))
+                        end if
+                        energy_eq(ibasis, ip) = energy(ibasis, ip)/mass_mat_coeff(size_ele(ie), etype(ie))
+                    end do
+
+                case('consistent')
+                    !Use a consistent mass matrix
+                    do jnod = 1, ng_node(etype(ie))
+                        do ibasis = 1, basis_num(ie)
+                            force_eq(:, ibasis, ip) = force(:, ibasis, ip) * mass_mat_inv(inod, jnod) &
+                                                      / mass_mat_coeff(size_ele(ie),etype(ie))
+                          if(need_virial) then
+                            virial_eq(:, :, ibasis, ip) = virial(:, :, ibasis, ip) * mass_mat_inv(inod, jnod) &
+                                                           / mass_mat_coeff(size_ele(ie),etype(ie))
+                          end if
+                          energy_eq(ibasis, ip) = energy(ibasis, ip) * mass_mat_inv(inod, jnod) &
+                                                  / mass_mat_coeff(size_ele(ie), etype(ie))
+                        end do
+                    end do
+ 
+                case default
+                    print *, 'Error: Mass matrix type ', mass_mat_ty, ' is not accepted'
+                    call mpi_abort(mpi_comm_world, 1, ierr)
+                end select
+            end do
+        end do
+        !Deallocate arrays we no longer need
+        deallocate(force, energy, stat = deallostat) 
+        if(need_virial) then
+            deallocate(virial, stat = deallostat) 
+        end if
+        if(deallostat /= 0) call alloc_error("Failure to deallocate force/energy/virial", deallostat)
+
+        return
+    end subroutine update_equiv
+
+    subroutine communicate_force_eq
+        !This subroutine communicates forces for all shared elements when needed (such as when using langevin dynamics 
+        integer :: ie, ip, i, je, inod, ibasis, ind
+        real(kind = wp), allocatable :: force_array(:), force_buff(:)
+
+        !If we have more than one processor than we need to share all this information for all elements that share data
+        if(pro_num > 1) then
+            allocate(force_array(3*ng_max_node*ele_shared_num*max_basisnum), stat = allostat)
+            if(allostat /= 0) call alloc_error("Failure to allocate force in communicate_force_eq", allostat)
+
+            force_array(:) = 0.0_wp
+
+            !Assign the buffers for reducing to calculate the equivalent forces. 
+            !The buffer will have empty space so the communications aren't completely 
+            !efficient memory wise but it shouldn't cause very bad slowdowns.
+            do ie = 1, ele_num_l
+                je = ele_id_shared(ie)
+
+                if(je /= 0) then
+                    do inod = 1, ng_node(etype(ie))
+                        ip = cg_node(inod, ie)
+                        do ibasis = 1, basis_num(ie)
+                            !Calculate the current index  and put the force, virial, and energy into the send arrays
+                            ind = 3*ng_max_node*max_basisnum*(je-1) + 3*max_basisnum*(inod-1) + 3*(ibasis-1)
+                            do i = 1, 3
+                                if(ind + i > 3*ng_max_node*ele_shared_num*max_basisnum) then
+                                    print *, 'Error: Index of force_array', &
+                                             ind+i, ' is larger than', &
+                                             ' array size', 3*ng_max_node*ele_shared_num*max_basisnum
+                                    call mpi_abort(mpi_comm_world, 1, ierr)
+                                end if
+                                force_array(ind+i) = force_eq(i, ibasis, ip)
+                            end do
+                        end do
+                    end do
+                end if
+            end do
+
+            !allocate force_buff, virial_buff, and energy_buff
+            allocate(force_buff(3*ng_max_node*ele_shared_num*max_basisnum), stat = allostat)
+            if(allostat /= 0) call alloc_error("Failure to allocate force_buff in update_equiv", allostat)
+
+            !Reduce all force_buff, energy_buff, and virial_buff
+            force_buff(:) = 0.0_wp
+            call mpi_allreduce(force_array, force_buff, 3*ng_max_node*ele_shared_num*max_basisnum, &
+                               mpi_wp, mpi_sum, world, ierr)
+
+            !update local energy_eq, force_eq, virial_eq from the buff received from all processors
+            do ie = 1, ele_num_l
+                je = ele_id_shared(ie)
+                if(je /= 0) then
+                  do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                      ind = 3*ng_max_node * max_basisnum * (je-1) + 3*(inod-1)*max_basisnum + 3*(ibasis-1)
+                      do i = 1, 3
+                        force_eq(i, ibasis, ip) = force_buff(ind+i)
+                      end do
+                    end do
+                  end do
+                end if
+            end do
+        end if
+        return
+    end subroutine communicate_force_eq
+
+    subroutine reset_tallies
+        !Reset energy and force tallies
+        energy_tally = 0
+        energy_equiv_tally = 0
+        f_norm_tally = 0
+    end subroutine
+
+end module forces

src/group.f90

@@ -0,0 +1,402 @@
+module group
+
+    use parameters
+    use elements
+    use box
+    use str
+    use comms
+
+    implicit none
+
+    integer, parameter :: max_group_num = 20
+    integer, save :: group_num, group_counts(4,max_group_num)
+    integer, dimension(10, max_group_num), save :: group_parameters_int
+    real(kind=wp), dimension(10, max_group_num) :: group_parameters_real
+    character(len=50), dimension(10, max_group_num) :: group_parameters_string
+    character(len=read_len), dimension(max_group_num) :: group_name, group_string, group_shape, which_in_group
+    
+
+    public 
+    contains 
+
+
+    subroutine group_defaults
+        group_parameters_int = 0
+        group_parameters_real=0.0_wp
+        group_counts = 0
+        group_name(1) = 'all'
+        group_num = 1
+    end subroutine group_defaults
+
+    subroutine init_group_all
+        !This initializes the all group
+        integer :: i, group_countme(4)
+        group_countme = 0
+
+        if(ele_num > 0) e_mask=0
+        if(atom_num > 0) a_mask=0
+        group_countme(1) = atom_num_l
+        group_countme(2) = ele_num_l
+        do i = 1, atom_num_l
+            a_mask(i)= ibset(a_mask(i), 1)
+        end do
+        do i = 1, ele_num_l
+            e_mask(i)= ibset(e_mask(i), 1)
+            group_countme(3) = group_countme(3) + ng_node(etype(i))*basis_num(i)
+            group_countme(4) = group_countme(4) + basis_num(i)*(size_ele(i)+1)**3
+        end do
+        call mpi_allreduce(group_countme, group_counts(:,1), 4, mpi_integer, mpi_sum, world, ierr)
+    end subroutine init_group_all
+
+    function get_group_index(gname)
+        !This subroutine returns the index of a group
+        character(len=*), intent(in) :: gname
+        integer :: get_group_index
+        integer :: i
+
+        get_group_index = 0
+        do i = 1, group_num
+            if (trim(group_name(i)) == trim(gname)) then 
+                get_group_index=i  
+                exit
+            end if
+        end do
+        return
+    end function get_group_index
+
+    subroutine parse_group(line)
+        !This subroutine parses the group command
+        character(len=*), intent(in) :: line 
+        integer :: iospara, i, j, shape_args
+        character(len=read_len) :: err, tmptxt
+        !First figure out what group_shape
+        group_num = group_num + 1
+        
+        j = tok_count(line)
+        
+        read(line, *, iomsg=err, iostat=iospara) tmptxt, group_name(group_num), which_in_group(group_num), group_shape(group_num),&
+                                                 (group_parameters_string(i,group_num), i = 1, j)
+        if(iospara > 0) call read_error(err, iospara)
+
+        !Check to make sure which_in_group is correct
+        select case(which_in_group(group_num))
+        case('elements', 'atoms', 'all')
+            continue
+        case default
+            call command_error("Group command doesn't accept selection based on "//trim(adjustl(which_in_group(group_num))) &
+                             //" should be elements, atoms, or all")
+        end select
+
+        !Now make sure that the group_shape is one of the acceptable options and check the inputted parameters
+        select case(group_shape(group_num)) 
+        case('block', 'sphere', 'type', 'file')
+            continue
+        case default
+            call command_error("Group command doesn't accept shape "//trim(adjustl(group_shape(group_num))) &
+                             //" should be block, sphere, or type")
+        end select
+
+
+        !Now parse the group parameters
+        select case(group_shape(group_num))
+        case('block')
+            do i =1, 6
+                call parse_pos(int((i+1)/2), group_parameters_string(i, group_num), group_parameters_real(i, group_num))
+            end do
+            shape_args = 6
+        
+        case('sphere')
+            do i =1, 3
+                call parse_pos(i, group_parameters_string(i, group_num), group_parameters_real(i, group_num))
+            end do
+            !Now get the radius
+            read(group_parameters_string(4, group_num), *, iostat = iospara, iomsg = err) group_parameters_real(i, group_num)
+            if(iospara > 0) call read_error(err, iospara)
+            group_parameters_real(4, group_num) = group_parameters_real(4, group_num) * group_parameters_real(4, group_num)
+            shape_args=4
+
+        case('type')
+            read(group_parameters_string(1,group_num), *, iostat = iospara, iomsg = err) group_parameters_int(1, group_num)
+            if(iospara > 0) call read_error(err, iospara)
+            shape_args = 1
+
+        case('file')
+            continue
+        end select
+
+        call assign_group(group_num)
+    end subroutine parse_group
+    
+    subroutine assign_group(i)
+        !This subroutine finds all elements and/or atoms within the group boundaries
+        !specified by the user.
+        integer, intent(in) :: i
+        integer ::  inod, ibasis, ia, ie, ip, group_countme(4), j, reada, reade, intag
+        integer, allocatable :: amap(:), emap(:)
+        real(kind=dp) :: rc(3)
+        character(len = read_len) :: msg
+
+        group_countme = 0
+        select case(trim(adjustl(group_shape(i))))
+        case('block')
+            write(msg, *) "Group ", trim(group_name(i)), " has block shape with boundaries: ", group_parameters_real(1:6, i)
+        case('sphere')
+            write(msg, *) "Group ", trim(group_name(i)), " has sphere shape with centroid ", group_parameters_real(1:3, i), & 
+                          " and radius ", group_parameters_real(4, i)
+        case('type')
+            write(msg, *) "Group ", trim(group_name(i)), " selects all atoms of type ", group_parameters_int(1,i)
+
+        case('file')
+            write(msg, *) "Group ", trim(group_name(i)), " is read in from file ", trim(adjustl(group_parameters_string(1,i)))
+        end select
+        call log_msg(msg)
+
+
+        !Assign atom groups
+        if(trim(adjustl(group_shape(i))) == "file") then 
+            !First make a map for the tags to position in the array
+            
+            open(unit=11, file=trim(adjustl(group_parameters_string(1,i))), status='old', action='read', position='rewind')
+            !First read in number of atoms/elements to read
+            read(11,*) reada, reade
+
+            !Now first read the atoms
+            if(reada > 0) then 
+                !If we are actually interested
+                if( (trim(adjustl(which_in_group(i))) == 'atoms').or. (trim(adjustl(which_in_group(i))) == 'all'))then 
+                    allocate(amap(maxval(tag_atom)))
+                    amap=0
+                    !First create the tag to index map
+                    do j = 1, atom_num_l
+                        amap(tag_atom(j)) = j 
+                    end do
+
+                    !Now read in the data and set the group mask
+                    do j = 1, reada
+                        read(11,*) intag
+                        if(intag <= size(amap)) then 
+                            if(amap(intag) > 0) then 
+                                a_mask(amap(intag)) = ibset(a_mask(amap(intag)),i)
+                                group_countme(1) = group_countme(1) + 1
+                            end if
+                        end if
+                    end do
+                else
+                    !Otherwise just read until you are done with the atom reading
+                    do j = 1, reada
+                        read(11,*) intag
+                    end do
+                end if
+            end if
+
+            if(reade > 0) then 
+                if( (trim(adjustl(which_in_group(i))) == 'elements').or. (trim(adjustl(which_in_group(i))) == 'all'))then 
+                    !First create the tag to index map
+                    allocate(emap(maxval(tag_ele)))
+                    emap =0
+                    do j = 1, ele_num_l
+                        emap(tag_ele(j)) = j
+                    end do
+
+                    !Now read in the data and set the group mask
+                    do j=1, reade
+                        read(11,*) intag
+                        if(intag <= size(emap)) then 
+                            if(emap(intag) > 0) then 
+                                e_mask(emap(intag)) = ibset(e_mask(emap(intag)), i)
+                                ie=emap(intag)
+                                if(who_has_ele(ie)) then 
+                                    group_countme(2) = group_countme(2) + 1
+                                    group_countme(3) = group_countme(3) + ng_node(etype(ie))*basis_num(ie)
+                                    group_countme(4) = group_countme(4) + basis_num(ie) * (size_ele(ie)+1)**3
+                                end if
+                            end if
+                        end if
+                    end do
+                end if
+            end if
+            close(11)
+        else
+            if((trim(adjustl(which_in_group(i))) == 'atoms').or. (trim(adjustl(which_in_group(i))) == 'all')) then 
+                do ia = 1, atom_num_l
+                    if( trim(adjustl(group_shape(i))) == 'type') then 
+                        if(type_atom(ia) == group_parameters_int(1,i)) then 
+                            a_mask(ia) = ibset(a_mask(ia), i)
+                            group_countme(1) = group_countme(1) + 1
+                        end if
+
+                    else if (in_group(i, r_atom(:,ia))) then 
+                        a_mask(ia) = ibset(a_mask(ia), i)
+                        group_countme(1) = group_countme(1) + 1
+                    end if
+                end do
+            end if
+
+            !Assign element groups
+            if((trim(adjustl(which_in_group(i))) == 'elements').or. (trim(adjustl(which_in_group(i))) == 'all')) then 
+                j=0
+                do ie = 1, ele_num_l
+                    if( trim(adjustl(group_shape(i))) == 'type') then 
+                        if(any(basis_type(:,ie) == group_parameters_int(1,i))) then 
+                            e_mask(ie) = ibset(e_mask(ie), i)
+                            if(who_has_ele(ie)) then 
+                                group_countme(2) = group_countme(2) + 1
+                                group_countme(3) = group_countme(3) + ng_node(etype(ie))*basis_num(ie)
+                                group_countme(4) = group_countme(4) + basis_num(ie)*(size_ele(ie)+1)**3
+                            end if
+                        end if
+
+                    else 
+                        !Otherwise get the element centroid 
+                        rc = 0.0_wp
+                        do inod = 1, ng_node(etype(ie))
+                            ip = cg_node(inod, ie)
+                            do ibasis = 1, basis_num(ie)
+                                rc = rc + r(:,ibasis, ip)
+                            end do
+                        end do
+                        rc = rc/(ng_node(etype(ie))*basis_num(ie))
+
+                        !If centroid is in group then we set the mask
+                        if (in_group(i, rc))  then 
+                            e_mask(ie) =  ibset(e_mask(ie), i)
+                            if(who_has_ele(ie)) then 
+                                group_countme(2) = group_countme(2) + 1
+                                group_countme(3) = group_countme(3) + ng_node(etype(ie))*basis_num(ie)
+                                group_countme(4) = group_countme(4) + basis_num(ie)*(size_ele(ie)+1)**3
+                            end if
+                        end if
+                    end if
+                end do
+            end if
+        end if
+
+        call mpi_allreduce(group_countme, group_counts(:,i), 4, mpi_integer, mpi_sum, world, ierr)
+        write(msg,*) "Group ", trim(group_name(i)), " with num ", i, " has ", group_counts(1,i), " atoms and ", &
+                      group_counts(2,i), " elements"
+        call log_msg(msg)
+
+
+    end subroutine assign_group
+
+    pure function in_group(g, r)
+        !Return true if in group
+        integer, intent(in) :: g
+        real(kind=wp), intent(in) :: r(3)
+
+        real(kind=wp) :: rsq, rdiff(3)
+        logical :: in_group
+
+        in_group = .false.
+
+        select case(trim(adjustl(group_shape(g))))
+        case('block')
+            in_group = in_block_bd(r(:), group_parameters_real(1:6, g))
+
+        case('sphere')
+            rdiff = r-group_parameters_real(1:3, g)
+            rsq = rdiff(1)*rdiff(1) + rdiff(2)*rdiff(2) + rdiff(3)*rdiff(3)
+            if (rsq < group_parameters_real(4, g)) in_group = .true.
+        end select
+
+    end function in_group
+
+    subroutine write_group(line)
+        !This subroutine writes out the group information to a file named after the group 
+        character(len=*),intent(in) :: line
+        
+        character(len=read_len) :: group_name, txtholder
+        integer :: g, at, el, a, e, i, counts_atom(pro_num), displs_atom(pro_num), counts_ele(pro_num), displs_ele(pro_num)
+        integer, allocatable :: gatoms(:), gelements(:), gatoms_gather(:), gelements_gather(:)
+
+        read(line, *) txtholder, group_name
+
+        g=get_group_index(group_name) 
+
+        !Now allocate the variables which will contain the tags
+        at=group_counts(1,g) 
+        el=group_counts(2,g)
+        allocate(gatoms(at), gelements(el)) 
+        
+        !Allocate gather variables on root
+        if(rank==root) then 
+            allocate(gatoms_gather(at), gelements_gather(el))
+        else
+            allocate(gatoms_gather(1), gelements_gather(1))
+        end if
+        
+        !Now add the atoms and element tags within the group to the list 
+        if(atom_num > 0) then
+            a=0
+            do i = 1, atom_num_l
+                if (btest(a_mask(i), g)) then 
+                    a=a+1
+                    gatoms(a) = tag_atom(i)
+                end if
+            end do
+        end if
+        if(ele_num > 0) then 
+            e=0
+            do i = 1, ele_num_l
+                if(who_has_ele(i)) then 
+                    if(btest(e_mask(i), g)) then 
+                        e=e+1
+                        gelements(e) = tag_ele(i)
+                    end if
+                end if
+            end do
+        end if
+
+        !First gather counts and displacements for atoms
+        if(atom_num > 0 ) then 
+            displs_atom=0
+            counts_atom=0
+            call mpi_gather(a, 1, mpi_integer, counts_atom, 1, mpi_integer, root, world, ierr) 
+            if(rank==root) then 
+                displs_atom=0
+                do i =2, pro_num
+                    displs_atom(i)=displs_atom(i-1)+counts_atom(i-1)
+                end do
+                if(at /= sum(counts_atom)) call misc_error("Sum of counts doesn't match atoms in group in write_group")
+            end if
+        end if
+
+        !Now on root gather counts and displacements for elements
+        if(ele_num > 0) then 
+            counts_ele=0
+            displs_ele=0
+            call mpi_gather(e, 1, mpi_integer, counts_ele, 1, mpi_integer, root, world, ierr) 
+            if(rank==root) then 
+                displs_ele=0
+                do i =2, pro_num
+                    displs_ele(i)=displs_ele(i-1)+counts_ele(i-1)
+                end do
+                if(el /= sum(counts_ele)) call misc_error("Sum of counts doesn't match eles in group in write_group")
+            end if
+        end if
+
+        !Now gatherv the tags to root
+        call mpi_gatherv(gatoms(1:a), a, mpi_integer, gatoms_gather, counts_atom, displs_atom, mpi_integer, root, world, ierr) 
+        call mpi_gatherv(gelements(1:e), e, mpi_integer, gelements_gather, &
+                         counts_ele, displs_ele, mpi_integer, root, world, ierr) 
+        
+        !Now write out the data if you are root 
+        if(rank==root) then 
+            open(unit=11, file=trim(adjustl(group_name))//"_tags.dat", action="write", status='replace', position='rewind')
+            write(11,*) at, el
+
+            if(atom_num > 0) then
+                do i=1, at
+                    write(11, *) gatoms_gather(i)          
+                end do
+            end if
+            if(ele_num > 0) then 
+                do i=1, el
+                    write(11, *) gelements_gather(i)          
+                end do
+            end if
+            close(11)
+        end if
+    end subroutine write_group
+
+end module group

src/input_parser.f90

@@ -0,0 +1,280 @@
+module input_parser
+    !This code is in charge of reading the code and running functions that mattter
+
+    use mpi 
+    use comms
+    use parameters
+    use potential
+    use eam
+    use read_data
+    use neighbors
+    use logger
+    use dump
+    use group
+    use minimize
+    use force_mod
+    use displace
+    use set
+    use deform
+    use modify
+    use langevin
+
+    implicit none
+
+    logical, private :: initialized
+
+    public 
+    contains
+
+    subroutine read_input
+        !Actually read the input, every processor should have access to the input arguments
+        !so we should be able to loop over these arguments
+        
+        character(len=read_len) :: line, label, req_commands(2), msg, loop_commands(100)
+        integer :: iosline, iospara, i, loop_times, nloopcom, nloop, j
+        logical :: req_flags(2), first_flag(2), read_loop_flag, run_loop_flag
+
+        initialized = .false.
+        req_flags(:) = .false.
+        read_loop_flag = .false.
+        run_loop_flag = .false.
+        nloopcom = 0
+        first_flag = .true.
+        req_commands(1) =  'read'
+        req_commands(2) = 'potential'
+        iosline = 0
+        do while (iosline == 0)
+            if(run_loop_flag) then 
+                if(j > nloopcom) then 
+                    j = 1
+                    nloop = nloop + 1  
+                    if(nloop > loop_times) then 
+                        run_loop_flag = .false.
+                        nloopcom = 0
+                        cycle
+                    end if
+                end if
+
+                line = loop_commands(j)
+                j = j+1
+            else
+                if(rank == root) then 
+                    line=''
+                    read(*, '(a)', iostat = iosline) line
+                    if(iosline > 0) then
+                        print *, 'Error: Wrong reading input file line ', line, &
+                                 ' because of', iosline
+                        call mpi_abort(mpi_comm_world, 1, ierr)
+                    end if
+            
+                    !scan(line, '#' /= 1) is used to skip all lines starting with #
+                    if((scan(line, '#') /= 1).and.(line /= '')) then
+
+                       !This communication needs to be done over mpi_comm_world to make sure every processor
+                        !is running the commands
+                        call mpi_bcast(line, read_len, mpi_character, root, mpi_comm_world, ierr)
+                    else 
+                        cycle
+                    end if
+                else
+                    call mpi_bcast(line, read_len, mpi_character, root, mpi_comm_world, ierr) 
+                    !Check for the exit input loop code 
+                    if (line == "exit input loop") exit
+                end if
+            end if
+
+            !Get the command 
+            read(line, *, iostat = iospara) label
+            if(iospara > 0) then
+                print *, 'Error: Wrong reading input file label ', label, &
+                         ' because of', iospara
+                call mpi_abort(mpi_comm_world, 1, ierr)
+            end if
+
+            !Log the command 
+            call log_msg(line,0)
+
+            !run the command
+            if(read_loop_flag) then 
+                if(label == 'endloop') then 
+                    read_loop_flag = .false.    
+                    run_loop_flag= .true.
+                    nloop = 1
+                    j = 1
+                else 
+                    nloopcom = nloopcom+1
+                    loop_commands(nloopcom) = trim(adjustl(line))
+                end if
+            else
+                select case(label)
+                case('loop')
+                    !Get the number of times to loop
+                    read(line, *) label, loop_times
+                    read_loop_flag = .true.
+                    nloopcom = 0
+
+                case('read_data')
+                    call parse_read(line)
+                    initialized=.false.
+                    need_vel=.false.
+                    need_force_pre=.false.
+                    req_flags(1) = .true.
+                case('potential')
+                    call parse_potential(line)
+                    req_flags(2) = .true.
+                case('neighbor')
+                    call parse_neighbors(line)
+                case('write_out')
+                    call parse_write_out(line)
+                case('dump')
+                    call parse_dump(line)
+                case('undump')
+                    call parse_undump(line)
+                case('timestep')
+                    call parse_timestep(line)
+                case('modify')
+                    call parse_modify(line)
+                case('group')
+                    call parse_group(line)
+                case('mass')
+                    call parse_mass(line)
+                case('debug')
+                    call parse_debug(line)
+                case('langevin')
+                    call parse_langevin(line)
+                case('setforce')
+                    if(first_flag(1)) then 
+                        call init_set_force
+                        first_flag(1) = .false.
+                    end if
+                    call parse_set_force(line)
+                case('addforce')
+                    if(first_flag(2)) then 
+                        call init_add_force
+                        first_flag(2) = .false.
+                    end if
+                    call parse_add_force(line)
+                case('displace')
+                    call displace_points(line)
+                case('ramp')
+                    call ramp_displace(line)
+                case('boundary')
+                    call parse_boundary(line)
+
+                    !Now regenerate the grid comm
+                    call mpi_cart_create(world, 3, num_pro, period, .false., grid_comm, ierr)
+                    call mpi_comm_rank(grid_comm, grank, ierr)
+                    call mpi_cart_coords(grid_comm, grank, 3, grid_coords, ierr) 
+
+                case('thermo')
+                    call parse_thermo(line)
+                case('types')
+                    call parse_types(line)
+                case('min_style')
+                    call parse_min_style(line)
+                case('minimize')
+                    select case(min_style)
+                    case(1)
+                        !If we are using fire than we need all of the info
+                        call pre_calc(2)
+                    case(2)
+                        !If we are using cg than we only need the virial
+                        call pre_calc(3)
+                    end select
+                    call parse_minimize(line)
+                case('run')
+                    do i=1, 2
+                        if(.not.req_flags(i)) then 
+                            print *, "Error: must call ", req_commands(i), " before run command"
+                            call mpi_abort(mpi_comm_world, 1, ierr)
+                        end if
+                    end do
+                    !Prepare for calculation
+                    call pre_calc(1)
+                    call parse_run(line)
+                case('dynamics')
+                    call parse_dynamics(line)
+                case('set')
+                    call parse_set(line)
+                case('temp')
+                    call parse_temp(line)
+                case('press')
+                    call parse_berendsen(line)
+                case('unpress')
+                    pflag=.false.
+                case('deform')
+                    call parse_deform(line)
+                case('thermo_style')
+                    call parse_thermo_style(line)
+                case('write_group')
+                    call write_group(line)
+                case default
+                    write(msg, *) 'Input parameter label ', trim(adjustl(label)), &
+                                  ' in line ', trim(adjustl(line)), ' is not accepted'
+                    call misc_error(msg)
+                end select
+            end if
+        end do
+
+
+        !Because root will be the only processor that has access to stdin we have to broadcast a code to all the 
+        !other processors for them to exit the input loop
+        if(rank == root) then 
+            line = "exit input loop"
+            call mpi_bcast(line, read_len, mpi_character, root, mpi_comm_world, ierr) 
+        end if
+
+        return
+    end subroutine read_input
+
+    subroutine pre_calc(runtype)
+        !This is the code which distributes the model and builds neighbor lists before calculation
+
+        !Runtype dictates what the command is being called for calculation. The option for runtype changes how flags are set
+        integer, intent(in) :: runtype
+
+        !Set flags and allocate variables
+        need_virial = .true.
+        select case(runtype)
+        case(1)
+            if(.not.need_vel) then 
+                need_vel = .true.
+                call alloc_velocity_arrays 
+            end if
+
+            if(.not.need_force_pre) then 
+                need_force_pre = .true.
+                call alloc_pre_array
+            end if
+        case(2)
+            if(.not.need_vel) then 
+                need_vel = .true.
+                call alloc_velocity_arrays 
+            end if
+            if(need_force_pre) then 
+                need_force_pre=.false.
+                if(atom_num > 0) deallocate(force_atom_pre)
+                if(ele_num>0) deallocate(force_eq_pre)
+            end if
+        case(3)
+            if(need_vel) then 
+                need_vel = .false.
+                call dealloc_velocity_arrays 
+            end if
+        end select
+        
+        if (.not. initialized) then 
+            !Set up the potential map
+
+            !Allocate necessary force and potential arrays
+            call alloc_force_arrays
+            call alloc_potential_arrays
+
+            initialized = .true.
+
+        end if
+
+    end subroutine pre_calc
+    
+end module input_parser
+

src/integration.f90

@@ -0,0 +1,467 @@
+module integration
+    !This module contains the code required for integration point setup and virtual atom data
+    use parameters
+    use comms
+    use elements
+    use errors
+    
+    implicit none
+
+    integer :: max_intpo_num, intpo_num, intpo_num_l
+    integer, save :: atomap_max_ele,  etype_count, etype_to_itype(defined_element_types), &
+                     intpo_nums(4, defined_element_types), intpo_count(defined_element_types)
+    integer, allocatable, save :: atom_intpo(:,:,:), who_rep_atomap(:,:,:)
+    real(kind = wp), allocatable, save :: weight_intpo(:,:,:)
+    real(kind = wp), allocatable, save ::  mass_mat_inv(:,:)
+    character(len = 100) :: mass_mat_ty
+    logical, allocatable, save :: who_has_intpo(:,:)
+
+    !Itype is the integration array type for the elements
+    integer, allocatable, save :: itype(:)
+
+    public
+    contains
+
+    subroutine integration_defaults
+        mass_mat_ty = 'lumped'
+    end subroutine integration_defaults
+
+    subroutine init_integration
+        !Initialize the integration
+        
+        integer :: i, j, ie, iep, local_iep(2), global_iep(2)
+        real(kind=wp) :: weight_temp
+        real(kind=wp) :: v_inv_matrix(8**2)
+
+        !First set up the mass arrays
+        !Allocate inverse mass arays
+        allocate(mass_mat_inv(8,8))
+
+        !Now calculate the inverse mass matrix, this is just for FCC 8 node elements
+        v_inv_matrix = [ 8.0_wp, -4.0_wp, 2.0_wp, -4.0_wp, -4.0_wp, 2.0_wp, -1.0_wp, 2.0_wp, &
+                        -4.0_wp, 8.0_wp, -4.0_wp, 2.0_wp, 2.0_wp, -4.0_wp, 2.0_wp, -1.0_wp, &
+                         2.0_wp, -4.0_wp, 8.0_wp, -4.0_wp, -1.0_wp, 2.0_wp, -4.0_wp, 2.0_wp, &
+                        -4.0_wp, 2.0_wp, -4.0_wp, 8.0_wp, 2.0_wp, -1.0_wp, 2.0_wp, -4.0_wp, &
+                        -4.0_wp, 2.0_wp, -1.0_wp, 2.0_wp, 8.0_wp, -4.0_wp, 2.0_wp, -4.0_wp, &
+                         2.0_wp, -4.0_wp, 2.0_wp, -1.0_wp, -4.0_wp, 8.0_wp, -4.0_wp, 2.0_wp, &
+                        -1.0_wp, 2.0_wp, -4.0_wp, 2.0_wp, 2.0_wp, -4.0_wp, 8.0_wp, -4.0_wp, &
+                         2.0_wp, -1.0_wp, 2.0_wp, -4.0_wp, -4.0_wp, 2.0_wp, -4.0_wp, 8.0_wp ]
+
+        mass_mat_inv(:,:) = reshape(v_inv_matrix, [8,8])
+        
+        !First communicate the etypes present, this array is only on the root processor as it's defined in read_restart
+        call mpi_bcast(etype_present, defined_element_types, mpi_logical, root, world, ierr)
+
+        !Assign the etype_to_itype array, this just maps the etype to the correct index of the itype variables
+        !This is because generally all the element types won't be used in one simulation to save on memory
+        j = 0
+        intpo_nums(:,:) = 0
+        intpo_count(:) = 0
+        etype_to_itype(:) = 0
+        do i = 1, defined_element_types
+            if (etype_present(i)) then
+                j=j+1
+                etype_to_itype(i) = j 
+                select case(i) 
+                    !Now set up the integration point definitions for FCC elements (Will be expanded to other element types
+                    !Intpo_nums has the integration point count for the integration schemes
+                    !The first index si the corner integration points, the second is the number of edge integration points, 
+                    !the third is the surface integration points, and the 4th is the interior integration points
+                case(1)
+                    !1NN element integration point count
+                    intpo_nums(:,j) = (/ 8, 12, 6, 1 /) 
+                    intpo_count(j) = 27
+                case(2,3)
+                    !2NN element integration point count
+                    intpo_nums(:,j) = (/ 64, 48, 12, 1 /)
+                    intpo_count(j) = 125
+                end select
+            end if
+        end do
+        
+        !Calculate max number of intpo nums for elements needed for model
+        max_intpo_num = maxval(intpo_count)
+
+        !Allocate arrays
+        etype_count = count(etype_present)
+        allocate(who_rep_atomap((max_size+1)**3, unique_sizes, etype_count), &
+                weight_intpo(max_intpo_num, unique_sizes, etype_count),  &
+                atom_intpo(max_intpo_num, unique_sizes, etype_count), &
+                stat = allostat)
+        if(allostat > 0) call alloc_error("Failure allocating weight arrays in init_integration", allostat)
+
+        !Now initialize the integration points for all of the elements that we need
+        !At the moment this code creates the integration points for all possible combinations of esize and etype
+        if(etype_present(1)) call init_rhomb(1)
+        if (etype_present(2))call init_rhomb(2)
+        if (etype_present(3)) call init_rhomb(2, 3)
+
+        !Now update the itypes for all the elements
+        call update_itype
+        !Now double check to make sure all of the weights for all elements add up correctly and count the number of integration
+        !points
+        local_iep = 0
+        global_iep = 0
+        do ie = 1, ele_num_l
+            weight_temp = 0.0_wp
+            do iep = 1, intpo_count(itype(ie))
+                weight_temp = weight_temp + weight_intpo(iep, size_to_shape(size_ele(ie)), itype(ie))
+            end do
+            if(.not. is_equal(weight_temp, real((size_ele(ie)+1)**3,wp))) then 
+                print *, "Error: weight_temp for element ", ie, " should equal ", (size_ele(ie)+1)**3
+                call mpi_abort(mpi_comm_world, 1, ierr)
+            end if
+            if(who_has_ele(ie)) then 
+                local_iep(1)  = local_iep(1) + intpo_count(itype(ie))
+                local_iep(2) = local_iep(2) + intpo_count(itype(ie))*basis_num(ie)
+            end if
+        end do
+
+        !Sum to get total intpo_num
+        call mpi_allreduce(local_iep, global_iep, 2, mpi_integer, mpi_sum, world, ierr)
+
+        !Now multiply by the maximum basis_num to get the right dimensions for the arrays
+        intpo_num = global_iep(2)
+
+        !Now update integration point arrays
+        call update_intpo
+
+    end subroutine init_integration
+
+    subroutine init_rhomb(intpo_depth, etyp)
+        !Initialize one NN rhombohedral elements
+        
+        !intpo_depth is the integration point depth. The only difference between 1NN and 2NN elements is this integration point
+        !depth
+        integer, intent(in) :: intpo_depth
+        integer, intent(in), optional :: etyp
+
+        integer :: i, j, k, ide, ix, iy, iz, ie, iep, esize, et, interp_count, intpo_set_num, iatom, &
+                    i_edge, i_node, i_surf, i_inner
+        real(kind=wp) :: node_weight, edge_weight, surf_rect_weight, inner_weight, x, y, z
+
+        !Variables needed for primitive unit cell definitions
+        real(kind=wp) :: weight_temp, cube_temp(24), cubic_mat(3,8),  prim_cell(3,max_basisnum, ng_max_node)
+        !We need a pb_in variable for the interp function even though the pb doesn't matter
+        integer ::pb_in(3, max_basisnum, ng_max_node)
+        !arrays needed for assigning integration points to virtual atoms
+        integer :: pos_to_iatom(max_size+1, max_size+1, max_size+1), atom_rep_iatom((max_size+1)**3)
+        real(kind=wp) :: all_atom_set((max_size+1)), r_in_nat(3, (max_size+1)**3), rtemp(3,max_basisnum)
+        character :: msg
+
+        !etype denotes the type of the element in the element type definition array. For the rhombohedral elements
+        !it's the same as the intpo_depth
+        if (present(etyp)) then 
+            et=etype_to_itype(etyp)
+        else
+            et=etype_to_itype(intpo_depth)
+        end if
+
+        !Initialize the matrix of node positions in natural coordinates
+        
+        cube_temp(:) = [ -1.0_wp, -1.0_wp, -1.0_wp, &
+                         1.0_wp, -1.0_wp, -1.0_wp, &
+                         1.0_wp, 1.0_wp, -1.0_wp, &
+                         -1.0_wp, 1.0_wp, -1.0_wp, &
+                         -1.0_wp, -1.0_wp, 1.0_wp, &
+                         1.0_wp, -1.0_wp, 1.0_wp, &
+                         1.0_wp, 1.0_wp, 1.0_wp, &
+                         -1.0_wp, 1.0_wp, 1.0_wp ]
+         
+        prim_cell(:,1, 1:8) = reshape(cube_temp, [ 3, 8])
+        pb_in(:,:,:) = 0
+
+        do ie = 1, unique_sizes
+            esize = shape_sizes(ie) 
+            node_weight = 1.0_wp
+            edge_weight = esize + 1 - 2*intpo_depth
+            surf_rect_weight = (esize + 1 - 2*intpo_depth)**2.0_wp
+            inner_weight = (esize + 1 - 2 * intpo_depth) **3.0_wp
+            
+            if(rank == root) then 
+                weight_temp = node_weight*intpo_nums(1, et) &
+                            + edge_weight*intpo_nums(2, et) &
+                            + surf_rect_weight*intpo_nums(3, et) &
+                            + inner_weight*intpo_nums(4, et) 
+                if(.not. is_equal(weight_temp, real((esize+1)**3, wp))) then 
+                    print *, "Error: Wrong total weight of integration points: ", weight_temp, ' for element type ', et, &
+                             " with esize ", esize, " should be ", (esize+1)**3
+                    call mpi_abort(mpi_comm_world, 1, ierr)
+                end if
+            end if
+
+            !Now figure out which iatoms are at integration point sites
+
+            !Elements are defined from -esize/2 to  esize/2 centered around 0. Here i has the number of interpolated atoms that are either 
+            ! greater than or less than 0. So for esize=4, the atoms are at -2 -1 0 1 2 and i will be 2
+            all_atom_set(:) = 0
+            if(mod(esize,2) == 0) then 
+                i = esize/2
+                do ide =1, i
+                    all_atom_set(2*ide) = -1.0_wp + 2.0_wp*(ide-1)/real(esize,wp)
+                    all_atom_set(2*ide+1) = 1.0_wp - 2.0_wp*(ide-1)/real(esize,wp)
+                end do
+            else 
+                i = (esize)/2 
+                all_atom_set(1)= 1/real(esize,wp)
+                all_atom_set(esize+1)= -1/real(esize,wp)
+                do ide =1, i
+                    all_atom_set(2*ide) = -1.0_wp + 2.0_wp*(ide-1)/real(esize,wp)
+                    all_atom_set(2*ide+1) = 1.0_wp - 2.0_wp*(ide-1)/real(esize,wp)
+                end do
+            end if            
+
+            !all_atom set contains only the positions which will have integration points. 
+            !As an example, for esize =4 and intpo_depth=1 all_atom_set is (0, -2, 2). All integration points
+            !positions can be created from those 3 values in natural coordinates
+
+
+            !First get the position of the interpolated atoms in the natural coordinates and find the relevant position in
+            !all_atom_set
+            interp_count  = (esize+1)**3
+            do iatom = 1, interp_count
+                call interp_atom(iatom, esize, 1, pb_in, 1, prim_cell, rtemp)
+                r_in_nat(:,iatom) = rtemp(:,1)
+            end do
+
+            !Now map the all_atom_set positions to iatoms
+            pos_to_iatom(:,:,:) = 0
+            do k = 1, esize+1
+                do j = 1, esize+1
+                    do i = 1, esize +1
+                        x = all_atom_set(i)
+                        y = all_atom_set(j)
+                        z = all_atom_set(k)
+                        do iatom = 1, interp_count
+                            if( is_equal(r_in_nat(1,iatom), real(x,wp)).and. &
+                                is_equal(r_in_nat(2,iatom), real(y,wp)).and. &
+                                is_equal(r_in_nat(3,iatom), real(z,wp))) then 
+
+                                pos_to_iatom(i,j,k) = iatom
+                                exit
+                            end if
+                        end do
+                    end do
+                end do
+            end do 
+
+            intpo_set_num = 2*intpo_depth + 1
+
+            !Now loop over all integration point
+            iep=0
+            i_node = 0 
+            i_edge = 0
+            i_surf = 0
+            i_inner= 0
+            atom_rep_iatom=0
+            do iz = 1, esize+1
+                do iy = 1, esize+1
+                    do ix = 1, esize + 1
+
+                        !Get the position for pos_to_iatom array
+                        iatom = pos_to_iatom(ix,iy,iz)
+
+                        !These are node integration points
+                        if(((ix > 1).and.(ix <= intpo_set_num)).and. &
+                            ((iy >1).and.(iy <= intpo_set_num)).and. &
+                            ((iz > 1).and.(iz <= intpo_set_num))) then 
+
+                            iep = iep + 1
+                            atom_intpo(iep, ie, et) = iatom
+                            weight_intpo(iep, ie, et) = node_weight
+                            atom_rep_iatom(iatom) = iatom
+                            i_node = i_node + 1
+
+                        !These are edge integration points 
+                        else if (((ix == 1).and.((iy > 1).and.(iy<=intpo_set_num)).and.((iz > 1).and.(iz<=intpo_set_num))).or. &
+                                 ((iy == 1).and.((ix > 1).and.(ix<=intpo_set_num)).and.((iz > 1).and.(iz<=intpo_set_num))).or. &
+                                 ((iz == 1).and.((iy > 1).and.(iy<=intpo_set_num)).and.((ix > 1).and.(ix<=intpo_set_num)))) then 
+
+                            iep = iep+1
+                            atom_intpo(iep, ie, et) = iatom
+                            weight_intpo(iep, ie, et) = edge_weight
+                            atom_rep_iatom(iatom) = iatom
+                            i_edge = i_edge+1
+
+                        !These are surface integration points
+                        else if(((ix == 1).and.(iy == 1).and.((iz > 1).and.(iz<=intpo_set_num))).or. &
+                                (((ix > 1).and.(ix<=intpo_set_num)).and.(iy == 1).and.(iz == 1)).or. &
+                                ((ix == 1).and.((iy > 1).and.(iy<=intpo_set_num)).and.(iz == 1))) then
+
+                            iep = iep+1 
+                            atom_intpo(iep, ie, et) = iatom
+                            weight_intpo(iep, ie, et) = surf_rect_weight
+                            atom_rep_iatom(iatom) = iatom
+                            i_surf = i_surf+1
+
+                        else if((ix == 1).and.(iy == 1).and.(iz == 1)) then
+                            !Interior integration point 
+                            iep = iep+1 
+                            atom_intpo(iep, ie, et) = iatom
+                            weight_intpo(iep, ie, et) = inner_weight
+                            atom_rep_iatom(iatom) = iatom
+                            i_inner = i_inner + 1
+
+                        !Now below are points which are represented by edge integration points
+
+                        else if(((ix == 1).or.(ix > intpo_set_num)).and. &
+                                 (iy > 1).and.(iy <= intpo_set_num).and. &
+                                 (iz > 1).and. (iz <= intpo_set_num)) then
+
+                            atom_rep_iatom(iatom) = pos_to_iatom(1, iy, iz)
+                            i_edge = i_edge + 1
+
+                        else if(((iy == 1).or.(iy > intpo_set_num)).and. &
+                                 (ix > 1).and. (ix <= intpo_set_num).and. &
+                                 (iz > 1).and.  (iz <= intpo_set_num)) then
+
+                            atom_rep_iatom(iatom) = pos_to_iatom(ix, 1, iz)
+                            i_edge = i_edge + 1
+
+
+                        else if(((iz == 1).or.(iz > intpo_set_num)).and. &
+                                (ix > 1).and. (ix <= intpo_set_num).and. &
+                                (iy > 1).and. (iy <= intpo_set_num)) then
+
+                            atom_rep_iatom(iatom) = pos_to_iatom(ix, iy, 1)
+                            i_edge = i_edge + 1
+
+                        !Now below are points which are represented by surface integration points
+
+                        else if(((ix == 1).or.(ix > intpo_set_num)).and. &
+                                ((iy == 1).or.(iy > intpo_set_num)).and. &
+                                (iz > 1).and.(iz <= intpo_set_num)) then
+
+                            atom_rep_iatom(iatom) = pos_to_iatom(1,1,iz)
+                            i_surf = i_surf + 1
+
+                        else if(((iy == 1).or.(iy > intpo_set_num)).and. &
+                                ((iz == 1).or.(iz > intpo_set_num)).and. &
+                                (ix > 1).and. (ix <= intpo_set_num)) then
+
+                            atom_rep_iatom(iatom) = pos_to_iatom(ix, 1, 1)
+                            i_surf = i_surf + 1
+
+                        else if(((ix == 1).or.(ix > intpo_set_num)).and. &
+                                ((iz == 1).or.(iz > intpo_set_num)).and. &
+                                (iy > 1).and. (iy <= intpo_set_num)) then
+
+                            atom_rep_iatom(iatom) = pos_to_iatom(1, iy, 1)
+                            i_surf = i_surf + 1
+
+
+                        !Otherwise it is represented by the interior integration point
+                        else 
+                            atom_rep_iatom(iatom) = pos_to_iatom(1,1,1)
+                            i_inner = i_inner + 1
+
+                        end if
+                    end do
+                end do
+            end do
+
+            !Now verify that all the counts match up
+            if ( (i_node+i_edge+i_surf+i_inner) /= interp_count) then 
+                print *, "Error: total considered interpolated points should equal ", interp_count, &
+                         " not ", (i_node+i_edge+i_surf+i_Inner), " in init_rhomb"
+                call mpi_abort(1, mpi_comm_world, ierr)
+            end if
+
+            !We now form the mapping array which dictates where in atom_intpo our representative integration point lies
+            who_rep_atomap = 0
+            do iatom = 1, interp_count
+                do iep = 1, intpo_count(et)
+                    if (atom_rep_iatom(iatom) == atom_intpo(iep, ie, et)) then 
+                        who_rep_atomap(iatom,ie, et) = iep 
+                    end if
+                end do
+                if (atom_rep_iatom(iatom)==0) then 
+                    write(msg, *) "atom_rep_iatom should not be 0 for iatom", iatom, " and esize ", esize
+                    call misc_error(msg)
+                end if
+            end do
+        end do
+
+    end subroutine init_rhomb
+
+    subroutine update_intpo
+        !This subroutine updates the ownership arrays for the integration points
+        
+        integer :: ie, iep, j, iatom, iatomap, ibasis, intpo_num_sum
+        
+        !First allocate who_has_intpo
+        if(allocated(who_has_intpo)) then 
+            if (ele_num_l > size(who_has_intpo,2)) deallocate(who_has_intpo)
+        end if
+        if(.not.allocated(who_has_intpo)) allocate(who_has_intpo(max_intpo_num*max_basisnum, ele_num_l))
+
+
+        intpo_num_l = 0
+        if(atomap_num_l > size(atomap_to_intpo,2)) then 
+            deallocate(atomap_to_intpo)
+            allocate(atomap_to_intpo(2,size(r_atomap,2)))
+        end if
+        atomap_to_intpo = 0
+        who_has_intpo(:, :) = .false.
+        do ie = 1, ele_num_l
+            j = size_to_shape(size_ele(ie)) 
+
+            do iep = 1, intpo_count(itype(ie))
+                iatom = atom_intpo(iep, j, itype(ie))
+                
+                do ibasis = 1, basis_num(ie)
+                    iatomap=cg_atomap(basis_num(ie)*(iatom-1) + ibasis, ie)
+
+                    !If iatomap /=0 then it's our iatomap
+                    if(iatomap /= 0) then 
+                        if(in_block_bd(r_atomap(:,iatomap), pro_bd)) then 
+                            intpo_num_l = intpo_num_l + 1 
+                            who_has_intpo(basis_num(ie)*(iep-1) + ibasis, ie) = .true.
+                            atomap_to_intpo(1,iatomap) = basis_num(ie)*(iep-1) + ibasis
+                            atomap_to_intpo(2,iatomap) = ie
+                        else
+                            print *, "Error: Atomap ", iatomap, " should belong to ", rank, " but doesn't"
+                            print *, "Pos is ", r_atomap(:,iatomap), " and bd is ", pro_bd
+                            call mpi_abort( mpi_comm_world, 1, ierr)
+                        end if
+                    end if
+
+                end do
+
+            end do
+        end do 
+
+        !Now check to make sure we have the right number of intpo
+        call mpi_reduce(intpo_num_l, intpo_num_sum, 1, mpi_integer, mpi_sum, root, mpi_comm_world, ierr)
+
+        if(rank == root) then 
+            if(intpo_num_sum /= intpo_num) then 
+                print *, "Error: Total integration point number ", intpo_num_sum, " does not equal ", intpo_num
+                call mpi_abort(mpi_comm_world, 1, ierr)
+            end if
+        end if
+
+        
+    end subroutine update_intpo
+
+    pure function mass_mat_coeff(esize, etype)
+        integer, intent(in) :: esize, etype 
+        real(kind=wp) :: mass_mat_coeff
+
+        mass_mat_coeff = real(esize+1,wp)**3.0_wp/real(ng_node(etype),wp)
+        return
+    end function mass_mat_coeff
+
+    subroutine update_itype
+        !This just updates the itype array for the local element num
+        integer :: i
+
+        if (allocated(itype)) deallocate(itype)
+        allocate(itype(ele_num_l))
+
+        do i = 1, ele_num_l
+            itype(i) = etype_to_itype(etype(i))
+        end do
+    end subroutine
+
+end module integration

src/langevin.f90

@@ -0,0 +1,119 @@
+module langevin
+    !This module contains all the code for running steps of the verlet algorithm
+    !This is equivalent to the NVE ensemble
+    use parameters
+    use comms 
+    use elements
+    use forces
+    use time
+    use atom_types
+    use group
+
+    implicit none
+
+    !Arguments passed in by users
+    real(kind=wp), private, save :: Tb, damp, T0 
+    real(kind=wp), private, save :: gfactor1(max_atom_types), gfactor2(max_atom_types)
+    integer, save :: langevin_group(20), lnum 
+    public
+    contains
+
+    subroutine langevin_defaults
+        lnum = 0 
+        langevin_group = 0
+    end subroutine langevin_defaults
+
+    subroutine parse_langevin(line)
+        !Parse the langevin thermostat command 
+        character(len=*), intent(in) :: line
+
+        character(len=read_len) :: tmptxt, g
+        integer :: i
+
+        if(tok_count(line) < 5) call command_error("Missing arguments for dynamics langevin command")
+        read(line, *) tmptxt, g, T0, Tb, damp
+
+        !Get the group for this langevin call
+        lnum = lnum + 1
+        langevin_group(lnum) = get_group_index(g)
+        if(langevin_group(lnum) == 0) then 
+            write(tmptxt,*) "Group name ", g, " not defined in langevin command"
+            call command_error(tmptxt)
+        end if
+
+        !Now get force prefactors for all atom types
+        do i = 1, natom_types
+            gfactor1(i) = -masses(i)/damp/ftm2v
+            gfactor2(i) = sqrt(masses(i)) * sqrt(24.0*boltzmann/damp/time_step/const_motion)/ftm2v
+        end do
+
+        return
+    end subroutine parse_langevin
+
+    subroutine langevin_post_force
+        integer :: i, ia, ie, ibasis, inod, ip
+        real(kind = wp) :: T_target, delta, tsqrt, fdrag(3), fran(3), rand, gam1, gam2
+
+        delta = (iter - begin_step)/(run_steps)
+
+        T_target = T0 + delta*(Tb-T0)
+        tsqrt=sqrt(T_target)
+
+        !update force with langevin for all atoms
+        !Loop over all langevin calls
+        do i = 1, lnum
+            do ia = 1, atom_num_l
+                if(btest(a_mask(ia), langevin_group(lnum))) then 
+                    gam1 = gfactor1(type_atom(i))
+                    gam2 = gfactor2(type_atom(i))*tsqrt
+
+                    call random_number(rand)
+                    fran(1) = gam2*(rand-0.5)
+                    call random_number(rand)
+                    fran(2) = gam2*(rand-0.5)
+                    call random_number(rand)
+                    fran(3) = gam2*(rand-0.5)
+
+                    fdrag(1) = gam1*vel_atom(1,ia)
+                    fdrag(2) = gam1*vel_atom(2,ia)
+                    fdrag(3) = gam1*vel_atom(3,ia)
+
+                    force_atom(1,ia) = force_atom(1,ia) + fdrag(1) + fran(1)
+                    force_atom(2,ia) = force_atom(2,ia) + fdrag(2) + fran(2)
+                    force_atom(3,ia) = force_atom(3,ia) + fdrag(3) + fran(3)
+                end if
+            end do
+            
+            do ie = 1, ele_num_l
+                if(btest(e_mask(ie), langevin_group(lnum)).and.(who_has_ele(ie))) then
+                    do inod = 1, ng_node(etype(ie))
+                        ip = cg_node(inod,ie)
+                        do ibasis = 1, basis_num(ie)
+                            gam1 = gfactor1(basis_type(ibasis,ie))
+                            gam2 = gfactor2(basis_type(ibasis,ie))*tsqrt
+
+                            call random_number(rand)
+                            fran(1) = gam2*(rand-0.5)
+                            call random_number(rand)
+                            fran(2) = gam2*(rand-0.5)
+                            call random_number(rand)
+                            fran(3) = gam2*(rand-0.5)
+
+                            fdrag(1) = gam1*vel_atom(1,ia)
+                            fdrag(2) = gam1*vel_atom(2,ia)
+                            fdrag(3) = gam1*vel_atom(3,ia)
+
+                            force_eq(1,ibasis,ip) = force_eq(1,ibasis,ip) + fdrag(1) + fran(1)
+                            force_eq(2,ibasis,ip) = force_eq(2,ibasis,ip) + fdrag(2) + fran(2)
+                            force_eq(3,ibasis,ip) = force_eq(3,ibasis,ip) + fdrag(3) + fran(3)                     
+                        end do
+                    end do
+                end if
+            end do
+        end do
+
+        if(ele_num > 0) call communicate_force_eq
+
+    end subroutine langevin_post_force
+
+end module langevin

src/logger.f90

@@ -0,0 +1,70 @@
+module logger
+    !This is in charge of logging to stdout and to log files
+    use parameters
+
+    logical,save :: log_on
+
+    public
+    contains
+
+
+    subroutine log_defaults
+        log_on=.true.
+    end subroutine log_defaults
+
+    subroutine init_log
+        !Open log file
+        if (log_on) then 
+            if (rank == root) then 
+               open(unit=51, file="cac.log", action='write', status='replace', position='rewind')
+            end if
+        end if
+
+    end subroutine init_log
+
+    subroutine log_msg(msg, isline, all_procs)
+        !Log to stdout and log file
+        character(len=*), intent(in) :: msg
+        integer, intent(in), optional :: isline !if 0 then no tab in front
+        logical, intent(in), optional :: all_procs !if .true. then all processors calling this write
+        integer :: tab
+        logical :: lognow
+
+        if(log_on) then 
+            lognow = .false.
+            if(present(all_procs)) then 
+                lognow = all_procs
+            end if
+            if(rank == root) lognow = .true.
+
+            if(present(isline)) then 
+                tab = isline
+            else 
+                tab = 1
+            end if
+
+            !write non-line information, which should be indented
+            if(lognow) then 
+                if(tab == 1) then 
+                    print *, "    ", trim(adjustl(msg))
+                    if(rank==root) write(51, "(a)") "    ", trim(adjustl(msg))
+
+                !Write line information which isn't indented 
+                else if(tab == 0) then 
+                    print *, trim(adjustl(msg))
+                    if(rank==root) write(51, "(a)") trim(adjustl(msg))
+                    
+                end if
+            end if
+        end if
+
+        return
+    end subroutine log_msg
+    
+    subroutine close_log
+        !Close the log file
+        if (log_on) then 
+            if(rank == root)  close(51)
+        end if
+    end subroutine close_log
+end module logger

src/main.f90

@@ -0,0 +1,74 @@
+! Copyright (c) 2017-2018 Georgia Institute of Technology. All Rights Reserved
+! Redistributing this source code is prohibited. This is a testing version of CAC.
+
+! This source code is provided as is, with no warranties or representations of accuracy 
+! or suitability for any application, and with no expectation of user support.
+
+! Please alert Alex Selimov (aselimov3@gatech.edu) with any bugs or changes made to source code.
+! Written by Shuozhi Xu (shuozhixu@ucsb.edu)
+program main
+
+    use mpi
+    use comms
+    use parameters
+    use input_parser
+    use integration 
+    use neighbors
+    use logger
+    use minimize
+    use time
+    use group
+    use dump
+    use thermo
+    use temp
+    use berendsen
+    use potential
+    use debug
+    use deform
+    use langevin
+
+    implicit none
+
+    !initialize mpi
+    call comm_init
+    !Initialize time
+    call time_defaults
+
+    !Start timer
+    program_start = mpi_wtime()
+
+    !Initialize log
+    call log_defaults
+    call init_log
+
+    !Initialize some default values
+    deform_num = 0
+
+    !Initialize some flags 
+    tflag = .false.
+    pflag = .false.
+    dflag = .false.
+    first_run = .true.
+
+    !Now call all necessary default setting subroutines
+    call potential_defaults
+    call integration_defaults 
+    call neighbors_defaults
+    call min_defaults
+    call group_defaults
+    call thermo_defaults
+    call dump_defaults
+    call langevin_defaults
+    call dynamics_defaults
+
+    !Run input parsing code
+    call read_input
+
+    !close log
+    call log_time
+    call close_log
+
+    call mpi_finalize(ierr)
+
+   stop
+   end program main

src/math.f90

@@ -0,0 +1,515 @@
+module math
+    !This contains math helper functions 
+    use mpi
+    use parameters
+
+    implicit none
+
+    public
+
+    contains 
+    subroutine sort_array(array_in, n, array_out, array_order)
+        !sort 1d real array from minimum to maximum
+
+        integer, intent(in) :: n
+        integer, dimension(n), intent(out) :: array_order
+        real(kind = wp), dimension(n), intent(in) :: array_in
+        real(kind = wp), dimension(n), intent(out) :: array_out
+
+
+        integer :: i, j, temp_int
+        real(kind = wp) :: temp
+
+        array_out(:) = array_in(:)
+        do i = 1, n
+            array_order(i) = i
+        end do
+
+        do i = 1, n
+            do j = i+1, n
+                if(array_out(i) > array_out(j)) then
+                    temp = array_out(j)
+                    array_out(j) = array_out(i)
+                    array_out(i) = temp
+                    temp_int = array_order(j)
+                    array_order(j) = array_order(i)
+                    array_order(i) = temp_int
+                end if
+            end do
+        end do
+        return
+    end subroutine sort_array
+
+    pure function identity_mat(n)
+        !real identity matrix of n by n
+
+        implicit none
+
+        integer, intent(in) :: n
+        real(kind = wp), dimension(n, n) :: identity_mat
+
+        integer :: i
+
+        identity_mat(:, :) = 0.0_wp
+
+        do i = 1, n
+            identity_mat(i, i) = 1.0_wp
+        end do
+
+        return
+    end function identity_mat
+ 
+    pure function cross_product(a, b)
+        !cross product between two 3*1 vectors
+        implicit none
+        real(kind = wp), dimension(3), intent(in) :: a, b
+        real(kind = wp), dimension(3) :: cross_product
+
+        cross_product(1) = a(2) * b(3) - a(3) * b(2)
+        cross_product(2) = a(3) * b(1) - a(1) * b(3)
+        cross_product(3) = a(1) * b(2) - a(2) * b(1)
+        return
+     end function cross_product
+
+    pure function triple_product(a, b, c)
+        !triple product between three 3*1 vectors
+        implicit none
+        real(kind = wp), dimension(3), intent(in) :: a, b, c
+        real(kind = wp) :: triple_product
+
+        triple_product = dot_product(a, cross_product(b, c))
+
+        return
+    end function triple_product
+
+    subroutine matrix_normal(a, n, a_nor)
+        !normalize an n by n matrix
+        implicit none
+        integer, intent(in) :: n
+        real(kind = wp), dimension(n, n), intent(in) :: a
+        real(kind = wp), dimension(n, n), intent(out) :: a_nor
+
+        real(kind = wp), dimension(n) :: v
+        integer :: i
+
+        a_nor(:, :) = a(:, :)
+        do i = 1, n
+            v(:) = a(:, i)
+            a_nor(:, i) = v(:) / norm2(v)
+        end do
+        return
+    end subroutine matrix_normal
+
+     subroutine matrix_lattice(a, n, iorh)
+        !check if a matrix is orthogonal and obey right hand rule
+        implicit none
+        integer, intent(in) :: n
+        real(kind = wp), dimension(n, n), intent(in) :: a
+        logical, dimension(2), intent(out) :: iorh
+
+        real(kind = wp), dimension(n) :: v, v_k
+        integer :: i, j
+
+        iorh(:) = .true.
+        i_loop: do i = 1, n
+            do j = i + 1, n
+
+                if(abs(dot_product(a(:, i), a(:, j))) > lim_small) then
+                    iorh(1) = .false.
+                end if
+
+                if(j == i + 1) then
+                    v(:) = cross_product(a(:, i), a(:, j))
+                    v_k(:) = v(:) - a(:, mod(j, n)+1)
+
+                else if((i == 1).and.(j == n)) then
+                    v(:) = cross_product(a(:, j), a(:, i))
+                    v_k(:) = v(:) - a(:, i+1)
+                
+                end if
+
+                if(norm2(v_k(:)) > lim_small) then
+                    iorh(2) = .false.
+                end if
+
+                if(all(iorh).eqv..false.) then
+                    exit i_loop
+                end if
+            end do
+        end do i_loop
+        return
+
+    end subroutine matrix_lattice
+
+    subroutine matrix_inverse(a, n, a_inv)
+        !inverse an n by n matrix
+        implicit none
+        integer, intent(in) :: n
+        real(kind = wp), dimension(n, n), intent(in) :: a
+        real(kind = wp), dimension(n, n), intent(out) :: a_inv
+        
+        integer :: i, j, k, piv_loc
+        real(kind = wp) :: coeff, sum_l, sum_u
+        real(kind = wp), dimension(n) :: b, x, y, b_piv
+        real(kind = wp), dimension(n, n) :: l, u, p
+        real(kind = wp), allocatable :: v(:), u_temp(:), l_temp(:), p_temp(:)
+
+        l(:, :) = identity_mat(n)
+        u(:, :) = a(:, :)
+        p(:, :) = identity_mat(n)
+
+        !LU decomposition with partial pivoting
+        do j = 1, n-1
+
+            allocate( v(n-j+1), stat = allostat )
+            if(allostat /=0 ) then
+                print *, 'Fail to allocate v in matrix_inverse'
+                call mpi_abort(1,mpi_comm_world,ierr)
+            end if
+
+            v(:) = u(j:n, j)
+            if(maxval(abs(v)) < lim_zero) then
+                print *, 'Fail to inverse matrix', a
+                call mpi_abort(1,mpi_comm_world,ierr)
+            end if
+
+            piv_loc = maxloc(abs(v), 1)
+
+            deallocate( v,  stat = deallostat )
+            if(deallostat /=0 ) then
+                print *, 'Fail to deallocate v in matrix_inverse'
+                call mpi_abort(1,mpi_comm_world,ierr)
+            end if
+
+            !partial pivoting
+
+            if(piv_loc /= 1) then
+
+                allocate( u_temp(n-j+1), p_temp(n), stat = allostat) 
+                if(allostat /=0 ) then
+                    print *, 'Fail to allocate p_temp and/or u_temp in matrix_inverse'
+                    call mpi_abort(1,mpi_comm_world,ierr)
+                end if
+
+                u_temp(:) = u(j, j:n)
+                u(j, j:n) = u(piv_loc+j-1, j:n)
+                u(piv_loc+j-1, j:n) = u_temp(:)
+                p_temp(:) = p(j, :)
+                p(j, :) = p(piv_loc+j-1, :)
+                p(piv_loc+j-1, :) = p_temp(:)
+
+                deallocate( u_temp, p_temp, stat = deallostat )
+                if(deallostat /=0 ) then
+                    print *, 'Fail to deallocate p_temp and/or u_temp in matrix_inverse'
+                    call mpi_abort(1,mpi_comm_world,ierr)
+                end if
+
+                if(j > 1) then
+                    allocate( l_temp(j-1), stat = allostat )
+                    if(allostat /= 0) then
+                        print *, 'Fail to allocate l_temp in matrix_inverse'
+                        call mpi_abort(1,mpi_comm_world,ierr)
+                    end if
+
+                    l_temp(:) = l(j, 1:j-1)
+                    l(j, 1:j-1) = l(piv_loc+j-1, 1:j-1)
+                    l(piv_loc+j-1, 1:j-1) = l_temp(:)
+                    
+                    deallocate(l_temp, stat = deallostat) 
+                    if(deallostat /=0 ) then
+                        print *, 'Fail to deallocate l_temp in matrix_inverse'
+                        call mpi_abort(1,mpi_comm_world,ierr)
+                    end if
+                end if
+            end if
+
+            !LU decomposition
+            do i = j+1, n
+                coeff = u(i, j)/u(j, j)
+                l(i, j) = coeff
+                u(i, j:n) = u(i, j:n)-coeff*u(j, j:n)
+            end do
+        end do
+
+        a_inv(:, :) = 0.0_wp
+
+        do j = 1, n
+            b(:) = 0.0_wp
+            b(j) = 1.0_wp
+            b_piv(:) = matmul(p, b)
+
+            !Now we have LUx = b_piv
+            !the first step is to solve y from Ly = b_piv
+            !forward substitution
+            do i = 1, n
+                if(i == 1) then
+                    y(i) = b_piv(i)/l(i, i)
+                else
+                    sum_l = 0
+                    do k = 1, i-1
+                        sum_l = sum_l+l(i, k)*y(k)
+                    end do
+                    y(i) = (b_piv(i)-sum_l)/l(i, i)
+                end if
+            end do
+
+        !then we solve x from ux = y
+        !backward subsitution
+            do i = n, 1, -1
+                if(i == n) then
+                    x(i) = y(i)/u(i, i)
+                else
+                    sum_u = 0
+                    do k = i+1, n
+                        sum_u = sum_u+u(i, k)*x(k)
+                    end do
+                    x(i) = (y(i)-sum_u)/u(i, i)
+                end if
+            end do
+
+!      put x into j column of a_inv
+            a_inv(:, j) = x(:)
+
+        end do
+
+        return
+     end subroutine matrix_inverse
+ 
+!    three point interpolation
+ 
+     function interp3(x, tab) 
+        
+        !this comes from dl poly
+        implicit none
+
+        real(kind = wp), intent(in) :: x
+        real(kind = wp), dimension(:), intent(in) :: tab
+        real(kind = wp) :: interp3
+
+        integer :: l
+        real(kind = wp) :: rdr, rrr, ppp, gk0, gk1, gk2, t1, t2
+ 
+ 
+        interp3 = 0.0_wp
+
+        if(x > tab(3)) then
+            interp3 = 0
+
+        else
+
+            rdr = 1.0_wp / tab(4)
+            rrr = x - tab(2)
+
+            l = min(nint(rrr*rdr), nint(tab(1))-1)
+            if(l < 5) then
+                interp3 = tab(5)
+            end if
+
+            ppp = rrr * rdr - real(l, wp)
+            gk0 = tab(l-1)
+            gk1 = tab(l)
+            gk2 = tab(l+1)
+            t1 = gk1 + (gk1 - gk0) * ppp
+            t2 = gk1 + (gk2 - gk1) * ppp
+
+            if(ppp < 0.0_wp) then
+                interp3 = t1 + 0.5_wp * (t2 - t1) * (ppp + 1.0_wp)
+
+            else if(l == 5) then
+                interp3 = t2
+
+            else
+                interp3 = t2 + 0.5_wp * (t2 - t1) * (ppp - 1.0_wp)
+
+            end if
+        end if
+ 
+        return
+     end function interp3
+ 
+ 
+     subroutine delete_duplicate(array_in, n, array_out, m)
+        !delete duplicates in an 1-d integer array, the others are 0
+        implicit none
+
+        integer, intent(in) :: n
+        integer, dimension(n), intent(in) :: array_in
+        integer, intent(out) :: m
+        integer, dimension(n), intent(out) :: array_out
+
+        integer :: i, j
+        integer, dimension(n) :: array_temp
+ 
+ 
+        m = 0
+        array_out(:) = 0
+        array_temp(:) = array_in(:)
+ 
+        do i = 1, n
+            if(array_temp(i) > 0) then
+                do j = i+1, n
+                    if(array_temp(i) == array_temp(j)) then
+                        array_temp(j) = 0
+                    end if
+                end do
+
+                m = m+1
+                array_out(m) = array_temp(i)
+ 
+            end if
+        end do
+
+        return
+     end subroutine delete_duplicate
+ 
+
+     subroutine normal_distribution(mean, dev, rand)
+        !return a normally distributed random number
+        implicit none
+        
+        real(kind = wp), intent(in) :: mean, dev
+        real(kind = wp), intent(out) :: rand
+
+        real(kind = wp) :: rand_uf, rand_us
+
+        rand_uf = -1.0_wp
+
+        do while(rand_uf < lim_zero)
+            call random_number(rand_uf)
+        end do
+
+        if(rand_uf <= 0.5_wp) then
+            call random_number(rand_us)
+            rand = sqrt(-2.0_wp * log(rand_uf)) * cos(2.0_wp * pi * rand_us)
+
+        else
+            call random_number(rand_us)
+            rand = sqrt(-2.0_wp * log(rand_uf)) * sin(2.0_wp * pi * rand_us)
+
+        end if
+
+        rand = mean + dev * rand
+
+        return
+    end subroutine normal_distribution
+
+    function is_equal(A,B)
+        real(kind=dp), intent(in) :: A, B
+        logical :: is_equal
+
+        if( (abs(A-B)) <= zerotol) then 
+            is_equal =  .true.
+        else
+            is_equal = .false.
+        end if
+        return
+    end function
+
+    function dumb_interp(test_x, xlo, ylo, xhi, yhi)
+        !Simple interpolation used just for validation in unit tests
+        real(kind=dp), intent(in) :: test_x, xlo, ylo, xhi, yhi
+        real(kind=dp) :: dumb_interp  
+        
+        dumb_interp = ((test_x - xlo)/(xhi-xlo))*(yhi-ylo) + ylo
+        return
+    end function
+
+    pure function in_block_bd(v, block_bd, check_bd)
+        !This function determines whether a point is within a block in 3d
+        !Input/output
+        real(kind=dp), dimension(3), intent(in) :: v
+        real(kind=dp), dimension(6), intent(in) :: block_bd
+        logical, dimension(3), optional, intent(in) :: check_bd
+        logical :: in_block_bd
+
+        !Other variables
+        integer :: i 
+        logical :: bool_bd(3)
+
+        in_block_bd = .true.
+        if(present(check_bd)) then 
+            bool_bd = check_bd
+        else
+            bool_bd(:)=.true.
+        end if
+
+
+        do i =1 ,3
+            if(bool_bd(i)) then 
+                !Check upper bound
+                if(v(i) >= (block_bd(2*i)) ) then 
+                    in_block_bd =.false.
+                    exit
+                !Check lower bound
+                else if (v(i) < (block_bd(2*i-1))) then 
+                    in_block_bd = .false.
+                    exit
+                end if
+            end if
+        end do
+
+    end function in_block_bd
+
+    pure function in_cutoff(rl, rk, rcmin, rcoff)
+        !This function returns true when rl and rk are separated by a distance between rcmin and rcoff
+        real(kind=wp), dimension(3), intent(in) :: rl, rk
+        real(kind=wp), intent(in) :: rcmin, rcoff
+        logical :: in_cutoff
+
+        real(kind=wp) :: rlk
+        rlk=norm2(rk-rl)
+
+        if (( rlk > rcoff).or.(rlk<rcmin)) then 
+            in_cutoff=.false.
+        else
+            in_cutoff=.true.
+        end if
+
+        return
+    end function
+
+    pure function neighbor_dis_free(rl, rk)
+        real(kind=wp), dimension(3), intent(in) :: rl, rk
+        real(kind=wp), dimension(4) :: neighbor_dis_free
+
+        neighbor_dis_free(1:3) = rk-rl
+        neighbor_dis_free(4) = norm2(neighbor_dis_free(1:3))
+
+        return
+    end function
+
+    subroutine interpolate(npoints, delta, tab, spline)
+        !Interpolate a tab array using cubic splines
+        integer, intent(in) :: npoints
+        real(kind=wp), intent(in) :: delta
+        real(kind = wp), dimension(npoints) :: tab
+        real(kind=wp), dimension(7,npoints), intent(out) :: spline
+
+        integer :: i
+
+        spline(7,:) = tab(:)
+        spline(6,1) = spline(7,2) - spline(7,1)
+        spline(6,2) = 0.5_wp*(spline(7,3) - spline(7,1))
+        spline(6, npoints-1) = 0.5_wp*(spline(7, npoints) - spline(7, npoints-2))
+        spline(6, npoints) = spline(7,npoints) - spline(7,npoints-1)
+
+        do i = 3, npoints-2
+            spline(6,i) = ((spline(7,i-2)-spline(7,i+2)) + 8.0_wp*(spline(7,i+1)-spline(7,i-1)))/12.0_wp
+        end do
+
+        do i = 1, npoints-1
+            spline(5,i) = 3.0_wp*(spline(7,i+1) - spline(7,i)) - 2.0_wp*spline(6,i) - spline(6,i+1)
+            spline(4,i) = spline(6,i) + spline(6, i+1) - 2.0_wp*(spline(7,i+1) - spline(7,i))
+        end do
+        spline(5,npoints) = 0.0_wp
+        spline(4,npoints) = 0.0_wp
+
+        do i =1, npoints
+            spline(3,i) = spline(6,i)/delta
+            spline(2,i) = 2.0_wp*spline(5,i)/delta
+            spline(1,i) = 3.0_wp*spline(4,i)/delta
+        end do
+
+    end subroutine interpolate
+
+end module math

src/min_arrays.f90

@@ -0,0 +1,190 @@
+module min_arrays
+    !This module contains all of the important min_arrays
+
+    use parameters
+    use elements
+    use errors
+
+    implicit none
+
+    !Arrrays needed for conjugate gradient minimization
+    real(kind=wp), allocatable, save :: hatom(:,:), hnode(:,:,:), gatom(:,:), gnode(:,:,:), rzeroatom(:,:), rzeronode(:,:,:)
+
+    public 
+    contains
+
+    subroutine alloc_min_arrays
+        !Initialize cg variables
+        if(ele_num > 0) then 
+            if(allocated(rzeronode)) deallocate(rzeronode, hnode, gnode)
+            allocate(hnode(3, max_basisnum, node_num_l), gnode(3, max_basisnum, node_num_l), &
+                     rzeronode(3, max_basisnum, node_num_l))
+        end if 
+
+        if(atom_num > 0) then 
+            if(allocated(rzeroatom)) deallocate(rzeroatom, hatom, gatom)
+            allocate(hatom(3,atom_num_l), gatom(3,atom_num_l), rzeroatom(3, atom_num_l))
+        end if
+    
+    end subroutine alloc_min_arrays
+
+    subroutine grow_at_min_arrays(seg_real)
+        !Grow atom min arrays
+        integer, intent(in), optional :: seg_real
+
+        integer :: seg_num
+        real(kind=wp), allocatable :: r_array(:,:), g_array(:,:), h_array(:,:)
+
+        
+        if(present(seg_real)) then 
+            seg_num = seg_real
+        else
+            seg_num = 1024
+        end if
+
+        allocate(r_array(3, size(rzeroatom,2)+seg_num), g_array(3, size(gatom,2)+seg_num), h_array(3, size(hatom,2)+seg_num))
+
+        r_array=0.0_wp
+        g_array=0.0_wp
+        h_array=0.0_wp
+
+        r_array(:,1:size(rzeroatom,2)) = rzeroatom
+        g_array(:,1:size(gatom,2)) = gatom
+        h_array(:,1:size(hatom,2)) = hatom
+
+        call move_alloc(r_array, rzeroatom)
+        call move_alloc(g_array, gatom)
+        call move_alloc(h_array, hatom)
+
+        return
+    end subroutine grow_at_min_arrays
+
+    subroutine grow_ele_min_arrays(seg_real)
+        !Grow atom min arrays
+        integer, intent(in), optional :: seg_real
+
+        integer :: seg_num
+        real(kind=wp), allocatable :: r_array(:,:,:), g_array(:,:,:), h_array(:,:,:)
+
+        if(present(seg_real)) then 
+            seg_num = seg_real
+        else
+            seg_num = 1024
+        end if
+
+        allocate(r_array(3, max_basisnum, size(rzeronode,3)+seg_num), &
+                 g_array(3, max_basisnum, size(gnode,3)+seg_num), h_array(3, max_basisnum, size(hnode,3)+seg_num))
+
+        r_array=0.0_wp
+        g_array=0.0_wp
+        h_array=0.0_wp
+
+        r_array(:,:,1:size(rzeronode,3)) = rzeronode
+        g_array(:,:,1:size(gnode,3)) = gnode
+        h_array(:,:,1:size(hnode,3)) = hnode
+
+        call move_alloc(r_array, rzeronode)
+        call move_alloc(g_array, gnode)
+        call move_alloc(h_array, hnode)
+
+        return
+    end subroutine grow_ele_min_arrays
+
+
+
+    subroutine pack_atom_cg(r0,g,h, send_cg)
+        !This subroutine packs the atom information for conjugate gradient minimization
+        real(kind=wp), dimension(3), intent(in) :: r0, g, h
+        real(kind=wp), dimension(:), intent(out) :: send_cg
+    
+        integer :: i, k
+    
+        !Now pack send_cg
+        k = 1 
+        do i = 1,3
+            send_cg(k) = r0(i)
+            k=k+1
+            send_cg(k) = g(i)
+            k=k+1
+            send_cg(k) = h(i)
+            k=k+1
+        end do
+    
+        return
+    
+    end subroutine pack_atom_cg
+
+    subroutine unpack_atom_cg(recv_cg, r0, g, h)
+        !This subroutine unpacks the atom information for cg minimization
+        real(kind=wp), dimension(:), intent(in) :: recv_cg
+        real(kind=wp), dimension(3), intent(out) :: r0, g, h
+    
+        integer :: i, k
+    
+        !Now unpack recv_cg
+        k = 1 
+        do i = 1,3
+            r0(i) = recv_cg(k)
+            k=k+1
+            g(i) = recv_cg(k)
+            k=k+1
+            h(i) = recv_cg(k)
+            k=k+1
+        end do
+    
+        return
+    
+    end subroutine unpack_atom_cg
+
+    subroutine pack_ele_cg(n, b, r0,g,h, send_cg)
+        !This subroutine packs the atom information for conjugate gradient minimization
+        integer, intent(in) :: n, b
+        real(kind=wp), dimension(3, max_basisnum, ng_max_node), intent(in) :: r0, g, h
+        real(kind=wp), dimension(:), intent(out) :: send_cg
+    
+        integer :: i, k, inod, ibasis
+    
+        !Now pack send_cg
+        k = 1 
+        do inod = 1, n
+            do ibasis = 1, b
+                do i = 1,3
+                    send_cg(k) = r0(i,ibasis,inod)
+                    k=k+1
+                    send_cg(k) = g(i,ibasis,inod)
+                    k=k+1
+                    send_cg(k) = h(i,ibasis,inod)
+                    k=k+1
+                end do
+            end do
+        end do 
+
+        return
+    end subroutine pack_ele_cg
+
+    subroutine unpack_ele_cg(n, b, recv_cg, r0, g, h)
+        !This subroutine packs the atom information for conjugate gradient minimization
+        integer, intent(in) :: n, b
+        real(kind=wp), dimension(:), intent(in) :: recv_cg
+        real(kind=wp), dimension(3, max_basisnum, ng_max_node), intent(out) :: r0, g, h
+    
+        integer :: i, k, inod, ibasis
+    
+        !Now pack send_cg
+        k = 1 
+        do inod = 1, n
+            do ibasis = 1, b
+                do i = 1,3
+                    r0(i,ibasis,inod)=recv_cg(k)
+                    k=k+1
+                    g(i,ibasis,inod)=recv_cg(k)
+                    k=k+1
+                    h(i,ibasis,inod)=recv_cg(k)
+                    k=k+1
+                end do
+            end do
+        end do 
+
+        return
+    end subroutine unpack_ele_cg
+end module min_arrays

src/minimize.f90

@@ -0,0 +1,309 @@
+module minimize
+
+    !This code contains the code needed to run the various types of dynamics
+    use parameters
+    use fire
+    use cg
+    use neighbors
+    use forces
+    use comms
+    use potential
+    use dump
+    use thermo
+    use errors
+    use logger
+    use debug
+
+    implicit none
+
+    real(kind=wp), save :: force_tol, energy_tol
+    integer :: min_style, max_iter, reset_num
+    real(kind=wp), parameter :: eps_energy = 1d-8
+
+    private :: pre_iter, post_iter, iterate
+    public
+    contains
+
+    subroutine min_defaults
+        !Set defaults
+        min_style = 1
+    end subroutine min_defaults
+
+    subroutine parse_min_style(line)
+        !parse the run command
+        character(len = *), intent(in) :: line
+        character(len=read_len) :: tmptxt, min_string, args(20)
+        integer ::iospara, j, i
+        real(kind=wp) :: val
+
+        read(line, *, iostat = iospara) tmptxt, min_string
+        if (iospara > 0) call read_error("Invalid read of min_string from min_style command", iospara)
+
+        select case(min_string)
+        case('fire', 'FIRE')
+            call fire_defaults
+            min_style = 1
+            j = tok_count(line) 
+            if(j > 2) then 
+                read(line, *) args(1:j)
+                i = 3
+                do while(i <= j)
+                    select case(args(i))
+                    case('alpha0', 'tmax', 'tmin')
+                        i = i + 1
+                        !Read param val
+                        read(args(i), *) val
+                        !set param val
+                        call set_fire_param(args(i-1),val)
+                    case default
+                        write(tmptxt, *) "Cannot pass argument ", trim(adjustl(args(i))), " to min_style with style cg"
+                        call misc_error(tmptxt)
+                    end select
+                    i = i + 1
+                end do
+            end if
+        case('cg', 'CG')
+            call command_error('Conjugate gradient not correctly working in this implementation of CAC')
+            call cg_defaults
+            min_style = 2
+            !Now parse additional options for cg
+            j = tok_count(line) 
+            if(j > 2) then 
+                read(line, *) args(1:j)
+                i = 3
+                do while(i <= j)
+                    select case(args(i))
+                    case('reset')
+                        i = i + 1
+                        !Read the number of iterations between resets
+                        read(args(i), *) reset_num
+                    case default
+                        write(tmptxt, *) "Cannot pass argument ", trim(adjustl(args(i))), " to min_style with style cg"
+                        call misc_error(tmptxt)
+                    end select
+                    i = i + 1
+                end do
+            end if
+        case default 
+            call command_error("Min_style "//trim(adjustl(min_string))//" is not currently accepted as an option for dynamics")
+        end select
+
+    end subroutine parse_min_style
+
+    subroutine parse_minimize(line)
+        character(len=*), intent(in) :: line
+        character(len=read_len) :: tmptxt
+        integer :: iospara
+
+        read(line, *, iostat = iospara) tmptxt,  energy_tol, force_tol, max_iter
+        if (iospara > 0) call read_error("Invalid read of minimize command", iospara)
+
+        if ((force_tol < 0)) then 
+            write(tmptxt, *) "Force tolerance ", force_tol, " should not be less than zero"
+            call misc_error(tmptxt)
+        end if
+        if ((energy_tol< 0)) then 
+            write(tmptxt, *) "Energy tolerance ", energy_tol, " should not be less than zero"
+            call misc_error(tmptxt)
+        end if
+        if ((max_iter<= 0)) then 
+            write(tmptxt, *) "max_iter", max_iter, " should not be less than or equal to zero"
+            call misc_error(tmptxt)
+        end if
+        
+        begin_step = iter
+        call run_min
+    end subroutine parse_minimize
+
+    subroutine run_min
+        !This subroutine actually runs the minimization
+        integer ::i, exit_cond, delay, nevals
+        real(kind=wp) :: old_energy, old_f_norm, pe, fnorm
+        character(len=read_len) :: msg
+
+
+        !Init neighbor list and do initial calc
+        if (nei_init) then 
+            call update_neighbor(iter, .false.,.true.)
+        else
+            if(ele_num > 0) call ghost_cg
+            if(atom_num> 0) call ghost_at
+            call neighbor_lists
+        end if
+        call update_force
+
+        !Initialize minimizer 
+        delay = 0
+        select case(min_style) 
+        case(1)
+            !Check to make sure that the timestep has been set 
+            if (is_equal(time_step, 0.0_wp)) then 
+                call misc_error("Time step must be set prior to calling minimize with min_style fire")
+            end if
+            call fire_init
+            delay = get_fire_delaystep()
+            !Initialize velocities to 0
+            if(node_num_l > 0) vel(:,:,:) = 0
+            if(atom_num_l > 0) vel_atom(:,:) = 0
+        case(2)
+            call cg_init
+        end select
+
+        if(first_run) call write_dump(iter, .true.)
+        call write_thermo_style
+        call write_thermo_out(iter)
+
+        exit_cond = 0
+
+        pe = compute_pe(1, .true.)
+        fnorm = compute_fnorm(1)
+        do i = 1, max_iter
+
+            iter = iter + 1
+            !Save old energies
+            old_energy=pe
+            old_f_norm =fnorm 
+
+            !Call pre_iterate
+            call pre_iter(i)
+
+            !Call iterate
+            call iterate(i, exit_cond)
+
+            if(min_style == 2) then 
+                call update_neighbor(iter, .true.)
+                call update_force
+
+                !Now check to see if we want to reset the conjugate direction. This may slow down the convergance, but may be
+                !useful for finite elements
+                if(reset_num > 0) then 
+                    if(mod(i, reset_num) == 0) then 
+                        call reset_cg_dir
+                    end if
+                end if
+            end if
+
+            !Exit if the minimizer tells us to
+            if(exit_cond > 0) exit 
+
+            !Check tolerances
+            if (i > delay) then 
+                pe = compute_pe(1, .true.)
+                fnorm = compute_fnorm(1)
+                if(abs(old_energy-pe)< energy_tol*0.5_wp*(abs(pe)+abs(old_energy)+eps_energy)) then 
+                    exit_cond = 1
+                    exit
+                else if (fnorm < force_tol) then 
+                    exit_cond = 2
+                    exit
+                end if
+            end if
+
+            !Call post iterate
+            call post_iter(i)
+        end do
+
+        !Compute virial
+        need_virial = .true.
+        call update_force
+
+        !Post completion thermo and dump
+        call write_thermo_out(iter)
+        call write_dump(iter, .true.)
+
+        !Post minimizer message to user
+        !First print the exit conditions
+        if(exit_cond < 3) then 
+            select case(exit_cond)
+            case(0) 
+                write(msg, *) "Max Iterations"
+            case(1)
+                write(msg, *) "Energy Tolerance"
+            case(2)
+                write(msg, *) "Force Tolerance"
+            end select
+        else 
+            select case(min_style)
+            case(1)
+                if(exit_cond == 3) write(msg, *) "Max P < 0 iterations"
+            case(2)
+                if(exit_cond == 4) write(msg, *) "Exit because search direction isn't downhill"
+
+                if(exit_cond == 5) write(msg, *) "All search direction components are 0"
+
+                if(exit_cond == 6) write(msg, *) "Alpha is equal to 0"
+
+                if(exit_cond == 11) write(msg, *) "No change to force between line search iterations"
+            end select
+        end if
+        call log_msg("Minimizer out with stopping condition: "//trim(adjustl(msg)))
+
+        !Now print number of evaluations and iterations and clean up 
+        select case(min_style)
+        case(1) 
+            nevals = get_fire_neval()
+            call fire_clean
+        case(2)
+            nevals = get_cg_neval()
+            call cg_clean
+        end select
+        write(msg,*) "Total number of iterations: ", i
+        call log_msg(msg)
+        write(msg, *) "Total number of force evals: ", nevals
+        call log_msg(msg)
+
+        write(msg, *) "Final and second-to-last energies: ", pe, old_energy
+        call log_msg(msg)
+
+        call log_neighbor_info
+
+        first_run = .false.
+    end subroutine run_min
+
+    subroutine pre_iter(i)
+        !This subroutine is run before each dynamics timeiter is calculated
+        
+        !i is the current iter number
+        integer, intent(in) ::i
+        
+        !If we are dumping this timeiter then we need to calculate the virial stress
+        if(need_dump(i)) need_virial = .true.
+        if((mod(i,thermo_every)==0).and.need_p) need_virial = .true. 
+        return
+    end subroutine pre_iter
+
+    subroutine post_iter(i)
+        integer, intent(in) :: i
+
+        integer :: pre_atom_num
+        !This subroutine is run after the dynamics timeiter is calculated
+        !i is the current iter number
+        
+        !Dump if we need it
+        call write_dump(i)
+
+        !Thermo if we need it 
+        if(mod(i,thermo_every)==0) call write_thermo_out(iter)
+
+        !Debug if we need it
+        if(dflag) call run_debug
+
+        need_virial = .false.
+        return
+    end subroutine post_iter
+
+    subroutine iterate(i, mincode)
+        !This subroutine calls the correct dynamics to run
+        !i is the current iter number
+        integer, intent(in) :: i
+        integer, intent(out) :: mincode
+        select case(min_style)
+        case(1)
+            call fire_iterate(i, mincode)
+        case(2) 
+            call cg_iterate(mincode)
+        end select
+        
+    end subroutine iterate
+
+end module minimize

src/modify.f90

@@ -0,0 +1,48 @@
+module modify
+    !This module is in charge of code which changes various aspects of current running program, mainly regarding options
+
+    use parameters
+    use neighbors 
+    use elements 
+    use potential
+
+    implicit none
+    
+    public 
+    contains
+
+    subroutine parse_modify(line)
+        character(len=*), intent(in) :: line
+
+        integer :: i, acount, iospara
+        character(len=read_len) :: args(20), msg
+        logical :: l
+
+        acount = tok_count(line)
+
+        read(line,*) (args(i), i=1, acount)
+
+        i = 2
+        do while (i < acount)
+            select case(args(i))
+            case('atomap_neighbors')
+                i=i+1
+                read(args(i), *, iostat=iospara, iomsg=msg) l
+                if(iospara > 0) call read_error(msg, iospara)
+                if(l) then 
+                    atomap_neighbors = .true.
+                else 
+                    atomap_neighbors = .false.
+                end if
+
+            case default
+                write(msg, *) "Argument ", args(i), " not accepted in modify command"
+            end select
+
+            i = i + 1
+        end do
+
+        
+    end subroutine parse_modify
+
+end module modify

src/morse.f90

@@ -0,0 +1,268 @@
+module morse
+    
+    !subroutines for pairtab potential style
+    
+    use parameters
+    use math 
+    use forces 
+    use elements 
+    use integration 
+    use neighbors 
+    use comms 
+    use errors
+    use atom_types
+
+    implicit none
+
+    real(kind=wp), allocatable, private, save :: pair_spline(:,:,:)
+    real(kind=wp), private, dimension(max_atom_types, max_atom_types), save :: pair_cutoffsq, d0, alpha, r0, morse1
+
+    public 
+    contains
+
+    subroutine add_morse_potential(type1, type2, ind0, inalpha, inr0, incutoff)
+        integer, intent(in) :: type1, type2
+        real(kind=wp), intent(in) :: ind0, inalpha, inr0, incutoff
+
+        integer :: i,j, mn
+
+        d0(type1, type2) = ind0
+        d0(type2, type1) = ind0
+        alpha(type1, type2) = inalpha
+        alpha(type2, type1) = inalpha
+        r0(type1, type2) = inr0
+        r0(type2, type1) = inr0
+        pair_cutoffsq(type1, type2)=incutoff*incutoff
+        pair_cutoffsq(type2, type1)=incutoff*incutoff
+        morse1(type1, type2) = 2*inalpha*ind0
+        morse1(type2, type1) = 2*inalpha*ind0
+
+        if((types_to_pot_type(type1, type2) > 0).or.(types_to_pot_type(type2,type1) > 0)) then 
+            call misc_error("Can't define multiple potentials for single pair interaction")
+        end if
+        types_to_pot_type(type1,type2)=ibset(types_to_pot_type(type1,type2),2)
+        types_to_pot_type(type2,type1)=ibset(types_to_pot_type(type2,type1),2)
+
+        if(.not.def_nei) then 
+            def_nei=.true.
+            rc_neigh=incutoff
+        else
+            rc_neigh=max(rc_neigh, incutoff)
+        end if
+
+    end subroutine add_morse_potential
+    
+    subroutine update_force_morse
+        integer :: i, ia, ie, iep, jep, ja, iatomap, jatomap, iatom, latomtype, katomtype, nei, mn_list, ibasis, ic, inod, ip
+        real(kind=wp) :: rl(3), rk(3), rlk(4), dr, d_exp, pair, flk(3), eshape, rsq
+
+        real(kind=wp), dimension(max_basisnum*max_intpo_num, ele_num_l) :: energy_intpo
+        real(kind=wp), dimension(3, max_basisnum*max_intpo_num, ele_num_l) :: force_intpo
+        real(kind=wp), dimension(3,3, max_basisnum*max_intpo_num, ele_num_l) :: virial_intpo
+
+        mn_list=0
+        do i = 1,2
+            if(potential_types(i)) mn_list=mn_list+1
+        end do 
+        energy_intpo=0.0_wp
+        force_intpo=0.0_wp
+        virial_intpo=0.0_wp
+
+        !First calculate energy/force for atoms
+        if (atom_num > 0) then 
+            do ia=1, atom_num_l
+                rl(:)=r_atom(:, ia)
+                latomtype=type_atom(ia)
+
+                do nei = 1, n_at_at(ia, mn_list)
+                    ja= at_nei_at(nei,ia,mn_list)
+                    rk=r_atom(:, ja)
+                    katomtype=type_atom(ja)
+
+                    rlk(1:3)=rl-rk
+                    rsq = rlk(1)*rlk(1) + rlk(2)*rlk(2) + rlk(3)*rlk(3)
+                    if(rsq < pair_cutoffsq(latomtype, katomtype)) then 
+                        rlk(4)=sqrt(rsq)
+                        dr=rlk(4)-r0(latomtype, katomtype)
+                        d_exp=exp(-alpha(latomtype, katomtype)*dr)
+                        flk=rlk(1:3)*(morse1(latomtype, katomtype)*(d_exp*d_exp-d_exp)/rlk(4))
+                        pair=d0(latomtype, katomtype)*(d_exp*d_exp-2.0_wp*d_exp) 
+
+                        energy_atom(ia)=energy_atom(ia)+pair/2.0_wp
+
+                        force_atom(:, ia) = force_atom(:, ia) + flk
+
+                        if(need_virial) then
+                            do ic = 1, 3
+                                virial_atom(:, ic, ia) = virial_atom(:, ic, ia) + flk(:) * rlk(ic) / 2.0_wp
+                            end do
+                        end if
+                        if (ja <= atom_num_l) then 
+                            energy_atom(ja)=energy_atom(ja) + pair/2.0_wp
+                            force_atom(:, ja) = force_atom(:, ja) - flk
+                            if(need_virial) then
+                                do ic = 1, 3
+                                    virial_atom(:, ic, ja) = virial_atom(:, ic, ja) + flk(:) * rlk(ic) / 2.0_wp
+                                end do
+                            end if
+                        end if
+                    end if
+                end do
+                do nei=1, n_at_cg(ia, mn_list)
+                    ja = at_nei_cg(nei, ia, mn_list)
+                    rk(:) = r_atomap(:, ja)
+                    katomtype = type_atomap(ja)
+
+                    rlk(1:3) = rl - rk
+                    rsq = rlk(1)*rlk(1) + rlk(2)*rlk(2) + rlk(3)*rlk(3)
+                    if(rsq < pair_cutoffsq(latomtype, katomtype)) then 
+                        rlk(4)=sqrt(rsq)
+                        dr=rlk(4)-r0(latomtype, katomtype)
+                        d_exp=exp(-alpha(latomtype, katomtype)*dr)
+                        flk=rlk(1:3)*(morse1(latomtype, katomtype)*(d_exp*d_exp-d_exp)/rlk(4))
+                        pair=d0(latomtype, katomtype)*(d_exp*d_exp-2.0_wp*d_exp) 
+                        energy_atom(ia)=energy_atom(ia)+pair/2.0_wp
+                        force_atom(:, ia) = force_atom(:, ia) + flk
+
+                        if(need_virial) then
+                            do ic = 1, 3
+                                virial_atom(:, ic, ia) = virial_atom(:, ic, ia) + flk(:) * rlk(ic) / 2.0_wp
+                            end do
+                        end if
+
+                        if(ja <= atomap_num_l) then 
+                            if(atomap_to_intpo(1,ja)/=0) then 
+                                jep = atomap_to_intpo(1,ja)
+                                ie = atomap_to_intpo(2,ja)
+
+                                force_intpo(:,jep,ie) = force_intpo(:,jep,ie) - flk(:)
+                                if(need_virial)then 
+                                    do ic = 1, 3
+                                        virial_intpo(:, ic, jep,ie) = virial_intpo(:, ic, jep,ie) + flk(:) * rlk(ic) / 2.0_wp
+                                    end do
+                                end if
+                                energy_intpo(jep,ie) = energy_intpo(jep,ie) + pair/2.0_wp
+                            end if
+
+                        end if
+                    end if
+                end do
+            end do 
+        end if
+
+        if(ele_num_l > 0) then 
+            do ie=1, ele_num_l
+                do iep=1, intpo_count(itype(ie))
+                    do ibasis=1, basis_num(ie)
+                        jep=basis_num(ie)*(iep-1)+ibasis
+                        if(who_has_intpo(iep, ie)) then 
+                            iatom = atom_intpo(iep, size_to_shape(size_ele(ie)), itype(ie))
+                            iatomap = cg_atomap(basis_num(ie)*(iatom-1) + ibasis, ie)
+                            latomtype = type_atomap(iatomap)
+                            rl(:) = r_atomap(:, iatomap) 
+                            
+                            do nei=1, n_cg_cg(jep, ie, mn_list)
+                                ja=cg_nei_cg(nei, jep, ie, mn_list)
+
+                                rk(:) = r_atomap(:, ja)
+                                katomtype = type_atomap(ja)
+
+                                rlk(1:3) = rl - rk
+                                rsq = rlk(1)*rlk(1) + rlk(2)*rlk(2) + rlk(3)*rlk(3)
+                                if(rsq < pair_cutoffsq(latomtype,katomtype)) then 
+
+                                    rlk(4) = sqrt(rsq)
+
+                                    dr=rlk(4)-r0(latomtype, katomtype)
+                                    d_exp=exp(-alpha(latomtype, katomtype)*dr)
+                                    flk=rlk(1:3)*(morse1(latomtype, katomtype)*(d_exp*d_exp-d_exp)/rlk(4))
+                                    pair=d0(latomtype, katomtype)*(d_exp*d_exp-2.0_wp*d_exp) 
+
+                                    force_intpo(:, jep, ie) = force_intpo(:, jep, ie) + flk(:)
+                                    if(need_virial) then
+                                        do ic = 1, 3
+                                            virial_intpo(:, ic, jep, ie) = virial_intpo(:, ic, jep, ie) + flk(:) * rlk(ic) / 2.0_wp
+                                        end do
+                                    end if
+                                    energy_intpo(jep, ie) = energy_intpo(jep, ie)+ pair/2.0_wp
+                                end if
+                            end do
+
+                            do nei=1, n_cg_at(jep, ie, mn_list)
+
+                                ja = cg_nei_at(nei, jep, ie, mn_list)
+                                rk(:) = r_atom(:, ja)
+                                katomtype = type_atom(ja)
+
+                                rlk(1:3) = rl - rk
+                                rsq = rlk(1)*rlk(1) + rlk(2)*rlk(2) + rlk(3)*rlk(3)
+                                if(rsq < pair_cutoffsq(latomtype,katomtype)) then 
+                                    rlk(4) = sqrt(rsq)
+
+                                    dr=rlk(4)-r0(latomtype, katomtype)
+                                    d_exp=exp(-alpha(latomtype, katomtype)*dr)
+                                    flk=rlk(1:3)*(morse1(latomtype, katomtype)*(d_exp*d_exp-d_exp)/rlk(4))
+                                    pair=d0(latomtype, katomtype)*(d_exp*d_exp-2.0_wp*d_exp) 
+
+                                    force_intpo(:, jep, ie) = force_intpo(:, jep, ie) + flk(:)
+                                    if(need_virial) then
+                                        do ic = 1, 3
+                                            virial_intpo(:, ic, jep, ie) = virial_intpo(:, ic, jep, ie) + flk(:) * rlk(ic) / 2.0_wp
+                                        end do
+                                    end if
+                                    energy_intpo(jep, ie) = energy_intpo(jep, ie)+ pair/2.0_wp
+
+                                end if
+                            end do
+                        end if
+                    end do
+                end do
+
+                do iep= 1, intpo_count(itype(ie))
+                    do ibasis=1, basis_num(ie)
+                        jep=basis_num(ie)*(iep-1)+ibasis
+                        iatom=atom_intpo(iep, size_to_shape(size_ele(ie)), itype(ie))
+                        iatomap=cg_atomap(basis_num(ie)*(iatom-1)+ ibasis, ie)
+
+                        if(who_has_intpo(jep, ie).eqv..true.) then
+                            force_intpo(:, jep, ie) = force_intpo(:, jep, ie) &
+                                                      * weight_intpo(iep, size_to_shape(size_ele(ie)), itype(ie))
+
+                            if(need_virial) then
+                              virial_intpo(:, :, jep, ie) = virial_intpo(:, :, jep, ie) &
+                                                      * weight_intpo(iep, size_to_shape(size_ele(ie)), itype(ie))
+                            end if
+                            energy_intpo(jep, ie) = energy_intpo(jep, ie) &
+                                                    * weight_intpo(iep, size_to_shape(size_ele(ie)), itype(ie))
+                        end if
+                    end do
+                end do
+
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do iep = 1, intpo_count(itype(ie))
+                        do ibasis = 1, basis_num(ie)
+                            jep = basis_num(ie)*(iep-1) + ibasis
+                            if(who_has_intpo(iep, ie).eqv..true.) then
+
+                                iatom = atom_intpo(iep, size_to_shape(size_ele(ie)), itype(ie))
+                                eshape = a_interpo(inod, iatom, size_to_shape(size_ele(ie)), etype(ie))
+                                force(:, ibasis, ip ) = force(:, ibasis, ip) + eshape * force_intpo(:, jep, ie)
+
+                                if(need_virial) then
+                                    virial(:, :, ibasis, ip) = virial(:, :, ibasis, ip) &
+                                                       + eshape * virial_intpo(:, :, jep, ie)
+                                end if
+
+                                energy(ibasis, ip) = energy(ibasis, ip) + eshape*energy_intpo(jep, ie)
+
+                            end if
+                        end do
+                    end do
+                end do
+
+            end do
+        end if
+    end subroutine update_force_morse
+
+end module morse

src/parameters.f90

@@ -0,0 +1,50 @@
+module parameters 
+
+    implicit none
+ 
+    !Precision defining parameters
+    integer, parameter :: dp = selected_real_kind(15, 307), &   ! double real
+                          qp = selected_real_kind(33, 4931), &  ! quadrupole real
+                          wp = dp
+    integer, parameter :: read_len = 500 !Read 500 characters for every input command
+    integer :: error
+
+    !Integers for which hold error codes
+    integer, save :: allostat, deallostat, ierr
+
+    !Chunk size for arrays
+    integer, parameter :: seg_num = 1024
+
+    !Various parameters used for tolerance checks
+    integer, save :: lim_large_int = huge(1)
+    real(kind = wp), parameter :: lim_zero = epsilon(1.0_wp), lim_small = epsilon(1.0), lim_large = huge(1.0)
+    real(kind=dp), parameter :: zerotol=1E-8
+ 
+    !constant in physics
+    real(kind = wp), parameter :: &
+        boltzmann = 8.6173324e-5_wp, &
+        avogadro = 6.02214129e23_wp, &
+        electron_volt = 1.602176565e-19_wp, &
+        amu = 1.6605402e-27_wp, & 
+        pi = 3.14159265358979323846_wp, &
+        !nktv2p is a conversion that lammps uses to get virial stress to atm
+        nktv2p = 1602176.5_wp, &
+        !ftm2v is another conversion factor from lammps used in fire
+        ftm2v = 1.0_wp/1.0364269d-4
+
+ 
+    !constant in motion equation and kinetic energy calculation, conversion from mv^2 to energy
+    real(kind = wp), parameter :: const_motion = 0.00010364269_wp 
+
+    !Parameters for simulator
+    character(len = 20), save :: simulator
+    logical,save :: need_virial = .false., first_run
+
+    !Cutoff radiuses
+    real(kind=wp), save :: rc_off, rc_min, rc_neigh, rc_sq
+
+    !Comm variables
+    integer, parameter :: root = 0
+    integer :: rank
+ 
+end module parameters

src/potential.f90

@@ -0,0 +1,217 @@
+module potential
+
+    use parameters
+    use eam
+    use morse
+    use forces
+    use comms
+    use str
+    use atom_types
+    use force_mod
+
+    implicit none
+
+    !This code handles controlling which potentials are called and processes potential input
+    integer :: pnum, enum, fnum 
+
+    !Spline arrays
+    public 
+    contains
+    
+    subroutine potential_defaults
+        potential_types=.false.
+        rdr = 0.0_wp
+        rdrho = 0.0_wp
+        nr = 0.0_wp
+        nrho = 0.0_wp
+        pnum = 0 
+        enum = 0 
+        fnum = 0
+        type_to_pair = 0
+        type_to_dens = 0 
+        pot_map = 0
+    end subroutine potential_defaults
+
+    subroutine parse_potential(line)
+        character(len = *), intent(in) :: line
+        character(len = 100) :: tmptxt, tmptxt2
+        character(len = 100) potential_type
+        character(len = read_len) :: filename
+        character(len=2), dimension(max_atom_types) :: names
+        integer :: iospara, i, j, mn, itype, jtype, lim
+        real(kind=wp) :: ind0, inalpha, inr0,cutoff
+
+        real(kind=wp), allocatable :: mpair(:)
+
+
+        read(line, *, iostat = iospara) tmptxt, potential_type
+        select case(potential_type)
+        case('eam','fs')
+
+            potential_types(1)=.true.
+
+            read(line, *, iostat = iospara) tmptxt, potential_type, filename
+            if(iospara> 0) call read_error("Error parsing potential command", iospara)
+            !Now if we have more than 2 tokens we read them in as atom types unless we have already set the atom types
+            j = tok_count(line)-3
+            if ((j > 0).and.(.not.atom_types_set)) then
+                read(line, *, iostat = iospara) tmptxt, potential_type, filename, (names(i), i = 1, j)
+
+                !and pass it to atom_types 
+                call set_atom_types(j, names)
+            end if                   
+            
+            if(potential_type == "eam") then 
+                call eam_lammps(filename, 1)
+            else if(potential_type == "fs") then 
+                call eam_lammps(filename, 1, .true.)
+            end if
+
+            call eamarray2spline
+
+            !Set cutoff radiuses
+            rc_off = min(d_finish, p_finish)
+            rc_sq = rc_off**2
+            rc_min = max(d_start, p_start, lim_small)
+            if (.not.def_nei) then 
+                def_nei = .true.
+                rc_neigh = rc_off
+            end if
+
+            call set_eam_map_arrays
+
+        case('morse')
+            potential_types(2)=.true.
+            !atom types have to be set before morse potential is called, it usually needs to be set with the types command
+
+            if(.not.atom_types_set) call misc_error("Atom types need to be set using types command before morse is used")
+
+            read(line, *) tmptxt, tmptxt2, itype, jtype, ind0, inalpha, inr0, cutoff
+            call add_morse_potential(itype, jtype, ind0, inalpha, inr0, cutoff)
+
+        case default
+            call command_error(trim(adjustl(potential_type))//" is not an acceptable potential type")
+        end select
+
+        !Log the atom types
+        !call log_types
+
+
+    end subroutine parse_potential
+
+    subroutine alloc_potential_arrays
+        !Initialize potential arrays
+        if (potential_types(1)) then
+            call alloc_eam_arrays
+        end if
+    end subroutine alloc_potential_arrays
+
+    subroutine update_force
+
+        real(kind=wp) :: t_start, t_end
+
+        call pre_force
+        t_start = mpi_wtime()
+
+        !First zero arrays
+        if(ele_num > 0) then 
+            if(allocated(force)) then 
+                if(node_num_l > size(force, 3)) then
+                    deallocate(force, energy)
+                    allocate(force(3, max_basisnum, node_num_l), energy(max_basisnum, node_num_l), stat = allostat)
+                    if(allostat /= 0) call alloc_error("Failure to allocate force/energy", allostat)
+                    if(need_virial) then 
+                        deallocate(virial)
+                        allocate(virial(3, 3, max_basisnum, node_num_l), stat = allostat)
+                        if(allostat /= 0) call alloc_error("Failure to allocate virial", allostat)
+                    end if
+                end if 
+            else
+                allocate(force(3, max_basisnum, node_num_l), energy(max_basisnum, node_num_l), stat = allostat)
+                if(allostat /= 0) call alloc_error("Failure to allocate force/energy", allostat)
+                if(need_virial) then 
+                    allocate(virial(3, 3, max_basisnum, node_num_l), stat = allostat)
+                    if(allostat /= 0) call alloc_error("Failure to allocate virial", allostat)
+                end if
+            end if
+
+            !Initialize force and energy
+            force(:, :, :) = 0.0_wp
+            energy(:, :) = 0.0_wp
+            !Allocate virial if needed
+            if(need_virial) then
+                virial(:, :, :, :) = 0.0_wp
+            end if
+
+        end if
+
+        if(atom_num > 0) then 
+            force_atom=0.0_wp
+            energy_atom=0.0_wp
+            if(need_virial) then 
+                virial_atom=0.0_wp
+            end if
+        end if
+
+        if(potential_types(1)) call update_force_eam
+        
+        if(potential_types(2)) call update_force_morse
+
+        !Now call update_equiv to update equivalent node value arrays if there are finite elements
+        if(ele_num > 0) call update_equiv
+        t_end = mpi_wtime()
+
+        walltime(2) = walltime(2) + (t_end-t_start)
+        call post_force
+    end subroutine update_force
+
+    subroutine pre_force
+        return
+    end subroutine pre_force
+
+    subroutine post_force
+        if(set_force_num > 0) call run_set_force
+        if((add_force_num > 0)) call add_force
+    end subroutine post_force
+
+!    subroutine pairtab(line)
+!        !This subroutine reads in tabulated morse potential files
+!        character(len=*), intent(in) :: line
+!        
+!        integer :: i, itype, jtype, mn
+!        real(kind=wp) :: mdr
+!        real(kind=wp), allocatable :: mpair(:)
+!        character(len = read_len) :: tmptxt, filename
+!
+!        read(line, *) tmptxt, itype, jtype, filename
+!        open(unit=21, file=trim(adjustl(filename)), status='old', action='read', position='rewind')
+!        !First read the step size and number of units, these start from the first step
+!
+!        read(21, *) mn, mdr
+!
+!        !Now check to make sure the morse step size is equivalent to the eam step size if the eam has already been defined
+!        if(rdr > 0.0_wp) then 
+!            if(.not.is_equal(1/mdr, rdr)) call misc_error("Step size for morse potential must match step size for eam potential")
+!        else 
+!            rdr = 0.0
+!        end if
+!
+!        !Now read in the potential table
+!        allocate(mpair(mn))
+!        do i = 1, mn
+!            read(21,*) mpair(i) 
+!        end do
+!
+!        !Now add the pair potential to the spline arrays
+!        call spline_arrays(mn,mn,mn,1,1,1)
+!        !
+!        embed_spline(:,:, size(embed_spline,3)) = 0.0_wp
+!        edens_spline(:,:, size(edens_spline,3)) = 0.0_wp
+!
+!        call interpolate(mn, mdr, mpair, pair_spline(:,:,size(pair_spline,3)))
+!        
+!        return
+!
+!    end subroutine pairtab
+
+end module potential

src/quenched_dynamics.f90

@@ -0,0 +1,110 @@
+module quenched_dynamics
+
+    use parameters
+    use comms
+    use elements
+    use neighbors
+    use potential 
+    use time
+    use vel_verlet
+
+    implicit none
+    public 
+    contains
+
+    subroutine qd(i)
+        integer, intent(in) :: i 
+
+        call update_r
+        call update_neighbor(i)
+        call update_force
+        call quenched_vel
+    end subroutine qd
+
+    subroutine quenched_vel
+        integer :: ia, ie, inod, ip, ibasis
+        real(kind = wp) :: pro_vel_p, pro_force_normsq, force_normsq, force_norm, vel_p
+
+
+        pro_vel_p = 0.0_wp
+        pro_force_normsq = 0.0_wp
+
+        !coarse-grained domain
+        if(ele_num /= 0) then
+            do ie = 1, ele_num_l
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                        vel(:, ibasis, ip) = vel(:, ibasis, ip) &
+                                       + 0.5_wp * (force_eq_pre(:, ibasis, ip) &
+                                       + force_eq(:, ibasis, ip)) / masses(basis_type(ibasis,ie)) &
+                                       * time_step / const_motion
+
+                        if(who_has_ele(ie).eqv..true.) then
+                            pro_vel_p = pro_vel_p + dot_product(vel(:, ibasis, ip), force_eq(:, ibasis, ip))
+                            pro_force_normsq = pro_force_normsq + dot_product(force_eq(:, ibasis, ip), force_eq(:, ibasis, ip))
+                        end if
+
+                    end do
+
+                end do
+
+            end do
+
+        end if
+
+        !atomistic domain
+        if(atom_num /= 0) then
+            do ia = 1, atom_num_l
+                vel_atom(:, ia) = vel_atom(:, ia) &
+                                      + 0.5_wp * (force_atom_pre(:, ia) &
+                                      + force_atom(:, ia)) / masses(type_atom(ia)) &
+                                      * time_step / const_motion
+
+                pro_vel_p = pro_vel_p + dot_product(vel_atom(:, ia), force_atom(:, ia))
+                pro_force_normsq = pro_force_normsq + dot_product(force_atom(:, ia), force_atom(:, ia))
+
+            end do
+
+        end if
+
+        !sum pro_vel_p and pro_force_normsq up to get vel_p and force_normsq
+        if(pro_num == 1) then
+            vel_p = pro_vel_p
+            force_normsq = pro_force_normsq
+
+        else
+            call mpi_allreduce(pro_vel_p, vel_p, 1, mpi_wp, mpi_sum, world, ierr)
+            call mpi_allreduce(pro_force_normsq, force_normsq, 1, mpi_wp, mpi_sum, world, ierr)
+
+        end if
+
+        force_norm = sqrt(force_normsq)
+!       decide if the nodes/atoms should be freezed
+!       coarse-grained domain
+
+        if(ele_num /= 0) then
+            do ip = 1, node_num_l
+                if((vel_p < 0.0_wp).or. (abs(vel_p) < lim_zero)) then
+                    vel(:, :, ip) = 0.0_wp
+                else
+                    !only use the component of the velocity parallel to the force
+                    vel(:, :, ip) = vel_p * force_eq(:, :, ip) / force_normsq
+                end if
+            end do
+        end if
+
+        !atomistic domain
+        if(atom_num /= 0) then
+            do ia = 1, atom_num_l
+                if((vel_p < 0.0_wp).or. (abs(vel_p) < lim_zero)) then
+                    vel_atom(:, ia) = 0.0_wp
+                else
+                    !only use the component of the velocity parallel to the force
+                    vel_atom(:, ia) = vel_p * force_atom(:, ia) / force_normsq
+                end if
+            end do
+        end if
+    end subroutine quenched_vel
+
+end module quenched_dynamics

src/read_data.f90

@@ -0,0 +1,339 @@
+module read_data
+    ! This code is in charge of all the reading and writing
+    use mpi
+    use math
+    use parameters
+    use elements
+    use box
+    use integration
+    use potential
+    use dynamics
+    use comms
+    use logger
+    use str
+    use time
+
+
+    public
+    contains
+
+    subroutine parse_read(line)
+        character(len = *), intent(in) :: line
+        character(len=read_len) :: tmptxt, filename
+        integer :: iospara
+
+        read(line, *, iostat = iospara) tmptxt, filename
+        if(iospara > 0) call read_error(" Invalid read of read_data command",iospara)
+
+        if(rank == root) then 
+            write(tmptxt,*) "Reading data from ", trim(adjustl(filename))
+            call log_msg(tmptxt)
+        end if
+        call read_model(filename)
+    end subroutine
+
+    subroutine read_model(filename)
+        !This subroutine is in charge of reading the model and distributing the model to the different processors
+        character(len=read_len), intent(in) :: filename
+        character(len=read_len) :: msg
+        integer :: numbers(8), i, j, k
+        real(kind=wp) :: box_mat_bcast(9)
+
+        numbers(:) = 0
+        if (rank == root)  then
+            !First read the file if root and broadcast numbers, currently only accepts restart files
+            call read_restart(filename) 
+            if (ele_num > 0) atomap_max = max_basisnum*(maxval(size_ele_scatter)+1)**3
+
+            numbers(1) = ele_num
+            numbers(2) = node_num
+            numbers(3) = atom_num
+            numbers(4) = atomap_num
+            numbers(5) = ng_max_node
+            numbers(6) = max_basisnum
+            numbers(7) = atomap_max
+            numbers(8) = iter
+            call mpi_bcast(numbers, 8, mpi_integer, root, world, ierr)
+            write(msg, *) "Read ", ele_num, " elements with ", node_num, " nodes and read ", atom_num, " atoms"
+            call log_msg(msg)
+        else
+            !If not root then wait to recieve files and then initialize numbers 
+            call mpi_bcast(numbers, 8, mpi_integer, root, world, ierr)
+            ele_num     = numbers(1) 
+            node_num    = numbers(2)
+            atom_num    = numbers(3)
+            atomap_num  = numbers(4)
+            ng_max_node = numbers(5) 
+            max_basisnum= numbers(6) 
+            atomap_max  = numbers(7)
+            iter = numbers(8)
+
+        end if
+
+        !Communicate masses
+        call mpi_bcast(masses, max_atom_types, mpi_wp, root, world, ierr)
+        !Now we initialize the local variable nums        
+        ele_num_l = nint((real(ele_num,wp) / pro_num) * 1.2_wp)
+        node_num_l = nint((real(node_num,wp) / pro_num) * 1.2_wp)
+        atom_num_l = nint((real(atom_num,wp) / pro_num) * 1.2_wp)
+        atomap_num_l = nint((real(atomap_num,wp) / pro_num) * 1.2_wp)
+        ele_num_lr = ele_num_l
+        node_num_lr = node_num_l
+        atom_num_lr = atom_num_l
+        atomap_num_lr = atomap_num_l
+        !Now get the largest number of atoms per element
+
+        !Now broadcast and record box information
+        call mpi_bcast(box_bd, 6, mpi_wp, root, world, ierr)
+        !Calculate box length
+        do i = 1, 3
+            box_length(i) = box_bd(2*i) - box_bd(2*i-1)
+        end do
+
+        !Now set the original box bounds
+        orig_box_bd = box_bd
+        orig_box_length = box_length
+
+        !Now broadcast box_bcs
+        call mpi_bcast(boundary, 3, mpi_character, root, world, ierr)
+        !Define logical periodic boundary variables
+        do i = 1,3
+            if (boundary(i:i) == 'p') then 
+                period(i) = .true.
+            else 
+                period(i) = .false.
+            end if
+        end do
+        periodic = any(period)
+        
+        !Now prepare box_mat buffer and broadcast
+        if(rank == root) then 
+            k = 1
+            do i = 1,3 
+                do j = 1, 3
+                    box_mat_bcast(k) = box_mat(i,j)
+                    k = k+1
+                end do
+            end do
+        end if
+        call mpi_bcast(box_mat_bcast, 9, mpi_wp, root, world, ierr)
+        if(rank /= root) then 
+            k = 1
+            do i = 1,3 
+                do j = 1, 3
+                    box_mat(i,j) = box_mat_bcast(k) 
+                    k = k+1
+                end do
+            end do
+        end if
+
+        !Now initialize original box_mat 
+        box_mat_ori = box_mat
+
+        !Now communicate the velocity flag
+        call mpi_bcast(need_vel, 1, mpi_logical, root, world, ierr)
+
+        !Now scatter the models
+        call divide_domain
+
+        if(ele_num > 0) then 
+            call alloc_cg_arrays
+            call scatter_cg
+            call init_integration
+        end if
+
+        if (atom_num > 0) then 
+            call alloc_at_arrays
+            call scatter_at
+        end if
+
+        !Init all group
+        call init_group_all
+    end subroutine read_model
+
+    subroutine read_restart(filename)
+        !First we read the restart file headers
+        character(len=read_len), intent(in) :: filename
+        integer :: iospara, i, j, ip, ib, inod, ibasis, bnum
+        character(len=2) :: paraline
+        character(len=read_len) :: line, label 
+        character(len=100) :: ioerror, msg
+        logical :: read_vel_cg, read_vel_at
+
+        etype_present(:) = .false.
+
+        !open the file for reading
+        open(1, file = trim(adjustl(filename)), status='old', action='read', position='rewind')
+
+        !Read the time
+        read(1, '(a)', iostat=iospara) paraline
+        read(1, *, iostat=iospara, iomsg=ioerror) iter, t
+        if(iospara>0) call read_error(ioerror, iospara)
+
+        !Read element number
+        read(1, '(a)', iostat=iosline) paraline 
+        read(1, *, iostat=iospara) ele_num
+        if(iospara>0) call read_error("Invalid read of element_num ", iospara)
+
+        !Read max interpolated atoms per element
+        read(1, '(a)', iostat=iosline) paraline 
+        read(1, *, iostat=iospara) atomap_max_ele
+        if(iospara>0) call read_error("Invalid read of max interpo", iospara)
+
+        !Read node number
+        read(1, '(a)', iostat=iosline) paraline
+        read(1, *, iostat=iospara) node_num
+        if(iospara>0) call read_error("Invalid read of node_num ", iospara)
+
+        !Read max nodes per element and basisnum
+        read(1, '(a)', iostat=iosline) paraline
+        read(1, *, iostat=iospara) ng_max_node, max_basisnum
+        if(iospara>0) call read_error("Invalid read of ng_max_node/max_basisnum ", iospara)
+
+        !Read number of atoms
+        read(1, '(a)', iostat=iosline) paraline
+        read(1, *, iostat=iospara) atom_num
+        if(iospara>0) call read_error("Invalid read of atom_num", iospara)
+
+        !Now read the atom type masses and map them to the right potential 
+        read(1, '(a)', iostat=iosline) paraline
+        read(1, '(a)', iostat=iosline) line
+        if(iospara>0) call read_error("Invalid read of atom_types ", iospara)
+        j = tok_count(line)
+        read(line, *, iostat=iospara) (masses(i), i = 1, j)
+
+        !Now read the box boundary definition
+        read(1, '(a)', iostat=iosline) paraline
+        read(1, *, iostat=iospara) boundary
+        if(iospara>0) then
+            print *, "Error: Invalid read of boundary with error code", iospara
+            call mpi_abort(mpi_comm_world, 1, ierr)
+        end if
+
+        !Read box_bd
+        box_bd(:) = 0.0_wp
+        read(1, '(a)', iostat=iosline) paraline
+        read(1, *, iostat=iospara) box_bd(1:6)
+        if(iospara>0) then
+            print *, "Error: Invalid read of box_bd with error code", iospara
+            print *, "Last line read was: ", paraline
+            call mpi_abort(mpi_comm_world, 1, ierr)
+        end if
+        
+        !Read box matrix 
+        box_mat(:,:)=0.0_wp
+        read(1, '(a)', iostat=iosline) paraline
+        do i=1,3
+            read( 1, *, iostat=iospara)  box_mat(1:3, i)
+            if(iospara>0) then
+                print *, "Error: Invalid read of box_mat with error code", iospara
+                call mpi_abort(mpi_comm_world, 1, ierr)
+            end if
+        end do
+
+
+        read_vel_cg=.false.
+        read_vel_at=.false.
+        ! Now read the cg part of the restart file
+        if(ele_num > 0) then 
+            !Initialize some coarse-grained variables and allocate scatter arrays
+            call scatter_cg_array
+
+            atomap_num = 0
+            !Read info lines
+            read(1, '(a)', iostat=iospara) line
+            read(1, '(a)', iostat=iospara) line
+
+            !Figure out if velocity information is included in this restart file
+            read(1, '(a)', iostat=iospara) line
+            read(line, *, iostat=iospara) (label, i =1 ,7)
+            if(trim(adjustl(label)) == 'velx') then
+                read_vel_cg = .true.
+            end if
+
+            !Now start reading the element information
+            do i=1,ele_num
+                read(1, '(a)', iostat=iospara) line
+                read(line, *, iostat=iospara, iomsg=msg) tag_ele_scatter(i), bnum, etype_scatter(i), size_ele_scatter(i)
+                if(iospara>0) call read_error(msg, iospara)
+
+                !Set the element_type to true
+                etype_present(etype_scatter(i)) = .true.
+
+                !Now read the nodes
+                do inod = 1, ng_node(etype_scatter(i))
+                    do ibasis =1 , bnum
+                        if(read_vel_cg) then 
+                            read(1, *, iostat=iospara) ip,ib,basis_type_scatter(ib, i),r_scatter(:, ib, ip),vel_scatter(:, ib, ip)
+                            if(iospara>0) then
+                                print *, "Error: Invalid read of node information with error code", iospara
+                                call mpi_abort(mpi_comm_world, 1, ierr)
+                            end if
+                        else
+                            read(1, *, iostat=iospara) ip, ib, basis_type_scatter(ib,i), r_scatter(:, ib, ip)
+                            if(iospara>0) then
+                                print *, "Error: Invalid read of node information with error code", iospara
+                                call mpi_abort(mpi_comm_world, 1, ierr)
+                            end if
+                        end if
+                    end do
+                    basis_num_scatter(i) = bnum
+                end do
+
+                !Figure out the number of atoms needed
+                select case(etype_scatter(i))
+                case(1,2,3)
+                    atomap_num =atomap_num +  bnum*((size_ele_scatter(i)+1)**3)
+                end select
+            end do
+     
+        end if
+
+        !Now read the atomistic information from the restart files
+        if(atom_num > 0) then 
+            !First allocate the data
+            call scatter_at_array
+            read(1, '(a)', iostat=iospara) line
+
+            !Figure out if velocity information is included in this restart file
+            read(1, '(a)', iostat=iospara) line
+            read(line, *, iostat=iospara) (label, i =1 ,6)
+            if(trim(adjustl(label)) == 'velx') then
+                read_vel_at = .true.
+            end if
+
+            !Now read the atomistic information
+            do i =1, atom_num
+                if(read_vel_at) then 
+                    read(1, *, iostat=iospara) tag_atom_scatter(i), type_atom_scatter(i), &
+                                               r_atom_scatter(1:3,i), vel_atom_scatter(1:3,i)
+                    if(iospara>0) then
+                        print *, "Error: Invalid read of atom information with error code", iospara
+                        call mpi_abort(mpi_comm_world, 1, ierr)
+                    end if
+                else
+                    read(1, *, iostat=iospara) tag_atom_scatter(i), type_atom_scatter(i), r_atom_scatter(1:3,i)
+                    if(iospara>0) then
+                        print *, "Error: Invalid read of atom information with error code", iospara
+                        call mpi_abort(mpi_comm_world, 1, ierr)
+                    end if
+            end if           
+            end do
+
+        end if
+
+        !Figure out if we need velocity, need_vel is only true if read_vel_cg and read_vel_at are both true
+        if ((ele_num > 0).and.(atom_num > 0)) then 
+            need_vel = (read_vel_cg ).and. read_vel_at
+        else if(ele_num > 0) then 
+            need_vel = read_vel_cg
+        else if(atom_num > 0) then 
+            need_vel = read_vel_at
+        end if
+
+        close(1)
+        return
+    end subroutine read_restart
+
+
+end module read_data

src/set.f90

@@ -0,0 +1,140 @@
+module set
+    ! sets per-atom values as required for random alloys, temperature initializiation
+    use elements
+    use group
+    use logger
+
+    implicit none
+    public
+    contains
+    
+    subroutine parse_set(line)
+    ! parse the 'set' command and set appropriate per-atom vals
+        character(len = *), intent(in) :: line
+        character(len=read_len) :: tmptxt, g, mode, msg
+        integer :: iospara, gnum, j, i
+        real(kind=wp) :: args(20)
+
+
+        if((ele_num == 0).and.(atom_num == 0)) call misc_error("Model must be read in before calling set command")
+        
+        read(line, *, iostat=iospara) tmptxt, g, mode
+        if(iospara > 0) call read_error("Failure to read set command", iospara)
+
+        gnum = get_group_index(g)
+        if(gnum == 0) then 
+            call misc_error("Group "//trim(adjustl(g))// " in set command has not been defined. "// &
+                            "Please define group before use")
+        end if
+
+        ! read in remaining arguments
+        j = tok_count(line)-3
+        if (j > 0) then
+            read(line, *, iostat = iospara) tmptxt, g, mode, (args(i), i = 1, j)
+        end if       
+
+        select case(mode)
+        case('type')
+            write(msg,*) "set ", group_counts(1,gnum), " atoms and ", group_counts(2,gnum), " elements to type: ", args(1)
+            call log_msg(msg)
+            call set_type(gnum, int(args(1)))
+        case('fraction')
+            if(group_counts(2,gnum) > 0) then
+                call command_error("Set fraction cannot operate on group "//trim(adjustl(group_name(group_num))) &
+                                //" containing elements")
+            endif
+            call set_fraction(gnum, int(args(1)), args(2))
+        case('etype')
+            if(group_counts(1,gnum) > 0)  call command_error("Set etype cannot operate on groups containing atoms")
+            call set_etype(gnum, int(args(1)))
+        case('vel')
+            if(allocated(vel_atom)) then 
+                write(msg,*) "set ", group_counts(1,gnum), " atoms and ", group_counts(2,gnum), " elements to vel ", args(1:3)
+                call set_vel(gnum, real(args(1),wp),real(args(2),wp), real(args(3),wp))
+            else
+                write(msg,*) "Velocity arrays are not allocated, velocity cannot be set"
+                call log_msg(msg)
+            end if
+            call log_msg(msg)
+        end select
+    end subroutine parse_set
+
+    subroutine set_type(gnum, type)
+        integer, intent(in) :: gnum, type
+        integer :: ia, ip, ibasis, ie
+
+        do ia = 1, atom_num_l
+            if(btest(a_mask(ia), gnum)) then 
+                type_atom(ia) = type
+            end if
+        end do
+        do ip = 1, node_num_l
+            ie = node_cg(ip)
+            if(btest(e_mask(ie), gnum)) then
+                do ibasis = 1, basis_num(ie)
+                    basis_type(ibasis,ie) = type
+                end do
+            end if
+        end do
+    end subroutine set_type
+
+    subroutine set_vel(gnum, vx, vy, vz)
+        integer, intent(in) :: gnum
+        real(kind = wp), intent(in) :: vx, vy, vz
+        integer ::ia, ip, ibasis, ie
+        real(kind=wp) :: v(3)
+
+        v(1) = vx
+        v(2) = vy
+        v(3) = vz
+
+        do ia = 1, atom_num_l
+            if(btest(a_mask(ia), gnum)) then 
+                vel_atom(:, ia) = v 
+            end if
+        end do
+        do ip = 1, node_num_l
+            ie = node_cg(ip)
+            if(btest(e_mask(ie), gnum)) then
+                do ibasis = 1, basis_num(ie)
+                    vel(:,ibasis,ip) = v
+                end do
+            end if
+        end do
+    end subroutine set_vel
+
+    subroutine set_fraction(gnum, type, frac)
+        integer, intent(in) :: gnum, type
+        real(kind=wp), intent(in) :: frac
+        character(len = read_len) :: msg
+        real(kind=wp) :: rand
+        integer :: ia, count
+        ! allocate fraction of group_counts array for randomization
+        count = 0
+        do ia = 1, atom_num_l
+            if(btest(a_mask(ia), gnum)) then 
+                call random_number(rand)
+                if (rand > frac) cycle
+                type_atom(ia) = type
+                count = count + 1
+            end if
+        end do
+        write(msg, *) "Set fraction swapped ", count, " atoms to type ", type
+        call log_msg(msg)
+        !group_counts(1,gnum)
+    end subroutine set_fraction
+
+    subroutine set_etype(gnum, et)
+        integer, intent(in) :: gnum, et
+        
+        integer :: i
+        do i = 1, ele_num_l
+            if (btest(e_mask(i), gnum)) then 
+                etype(i) = et
+            end if
+        end do
+
+        return
+    end subroutine set_etype
+
+end module set

src/str.f90

@@ -0,0 +1,46 @@
+module str
+
+    !this module has some string manipulation commands 
+    public
+    contains
+
+    pure function tok_count(text)
+        !counts number of tokens in a string
+        character(len =  *), intent(in) ::  text
+        integer :: tok_count
+        integer :: i, j
+        logical :: in_tok
+
+        j = len(trim(adjustl(text)))
+        in_tok = .false.
+        tok_count = 0
+        do i = 1, j
+            !This checks if it is a white space character which is the delimiter
+            if(trim(adjustl(text(i:i))) == ' ') then 
+                !If previously we were in token and the current character is the delimiter 
+                !Then we are no longer in the token
+                if(in_tok) in_tok = .false.
+
+            !If the character isn't a white space character and we previously weren't in the token then set in_tok 
+            !to true and increment token count
+            else if(.not.in_tok) then 
+                in_tok = .true.
+                tok_count = tok_count + 1
+            end if
+        end do
+        return
+    end function tok_count
+
+       subroutine to_lower(str)
+     character(*), intent(in out) :: str
+     integer :: i
+ 
+     do i = 1, len(str)
+       select case(str(i:i))
+         case("A":"Z")
+           str(i:i) = achar(iachar(str(i:i))+32)
+       end select
+     end do  
+   end subroutine to_lower
+
+end module str

src/temp.f90

@@ -0,0 +1,427 @@
+module temp 
+
+    use parameters
+    use mpi 
+    use comms
+    use elements 
+    use group
+    use compute 
+    use time
+    use atom_types
+
+    implicit none
+
+    integer :: Nf(2), gnum
+    real(kind=wp) :: Tinit=0.0_wp !This is the target temp for the velocity initialization subroutine
+
+    !Target temp and kinetic energy for rescaling subroutines, we have three Ktarget values currently for testing
+    real(kind=wp) :: Ttarget = 0.0_wp, Ktarget(3), urms(max_atom_types)
+
+    real(kind=wp) :: time_constant !The time constant used to calculate the rescaling coefficient
+    real(kind=wp) :: omega !This is the average frequency used for applying an oscillation to the interpolated atoms
+
+    logical :: tflag
+    integer, private :: delay
+
+    public 
+    contains
+
+    subroutine parse_temp(line)
+        !This subroutine parses the temperature command
+        character(len = *), intent(in) :: line
+        character(len = read_len) :: tmptxt, group_id, command, args(10)
+        integer :: iospara,  i, g
+        real(kind = wp) :: K(3), T 
+
+        delay = 1.0_wp
+        read(line, *, iostat = iospara) tmptxt, command
+
+        !Initialize random number generator
+        call random_seed()
+
+        select case(command)
+        case('create')
+            !Read the temperature command 
+            read(line, *, iostat = iospara) tmptxt, command, group_id, T
+
+        case('control')
+            omega = 0.0_wp
+            !Read the temperature command 
+            read(line, *, iostat = iospara) tmptxt, command, group_id, T, time_constant
+
+            !Check for optional arguments 
+            read(line, *, iostat = iospara) args
+            i = 5
+            do while(i < tok_count(line))
+                i = i + 1
+                select case(args(i))
+                case('delay')
+                    i = i + 1
+                    read(args(i), *) delay
+                end select
+            end do
+            
+        end select
+
+        g = get_group_index(group_id)
+        if(g == 0) then 
+            call misc_error("Missing group name in temp command")
+        end if
+        !Nf(1) is atomic dof and Nf(2) is elemental dof
+        Nf(1) = 3*group_counts(1, g)
+        Nf(2) = 3*group_counts(4, g)
+
+        !1st component is target energy for all degrees of freedom
+        K(1) = (Nf(1)+Nf(2))*boltzmann*T/2.0_wp
+        !2nd is for atomic dof
+        K(2) = (Nf(1))*boltzmann*T/2.0_wp
+        K(3) = (Nf(2))*boltzmann*T/2.0_wp
+
+        select case(command)
+        case('create')
+            write(tmptxt, *) "Initializing velocities to match temperature", T, " with kinetic energy",  K(1)
+            call log_msg(tmptxt)
+            call init_vel(g,K)
+        case('control')
+            Ktarget = K
+            Ttarget = T
+            gnum = g
+
+            !if (Nf(2) > 0) then
+            !    !Check to see if we have elements, if we do then we have to pass a frequency suboption dictating the frequency of
+            !    !oscillation to apply to the elements
+            !    read(line, *, iostat = iospara, iomsg = msg) tmptxt, command, group_id, Ttarget, time_constant, tmptxt, om
+            !    if(iospara > 0) call read_error(msg, iospara)
+            !    !Inputted frequency must be converted to angular frequency, the input frequency should be given in THz
+            !    omega = omega*2*pi*10.0_wp**12
+
+            !    !Now calculate the root mean-squared displacement magnitude for each different atom type
+
+            !    do i = 1, natom_types
+            !        urms(i) = sqrt((3*10d20*boltzmann*electron_volt*Ttarget)/(masses(i)*amu*omega**2))
+            !    end do
+            !end if
+
+            write(tmptxt, *) "Running temperature control: Target Ke is ", Ktarget(1), " target temp is ", &
+                              Ttarget, " with a time", "constant of ", time_constant
+            call log_msg(tmptxt)
+
+            if(omega>lim_small) then 
+                write(tmptxt,*) "Applying a mean square displacement of ", (urms(i), i =1, natom_types), " for atom types ", &
+                                (i, i =1, natom_types)
+                call log_msg(tmptxt)
+            end if
+            tflag = .true.
+        end select
+
+        return
+    end subroutine parse_temp
+
+    subroutine init_vel(g, Ktar)
+        !This subroutine initializes velocities to a random gaussian distribution around the desired temperature
+        real(kind=wp), intent(in) :: Ktar(3)
+        integer, intent(in) :: g
+        integer :: i, j, ibasis, id, inod, ip, ie
+        real(kind=wp) :: alpha, Kme, Kall, vel_buff(3*ele_num*max_basisnum*ng_max_node)
+    
+        Kme = 0.0_wp
+        
+        !Allocate velocity arrays if not already allocated
+        if(.not. need_vel) call alloc_velocity_arrays
+
+        if(atom_num > 0) then 
+            do i=1, atom_num_l
+                if (btest(a_mask(i), g)) then 
+                    do j = 1, 3
+                        vel_atom(j,i) = gasdev()
+                        Kme = Kme + 0.5_wp * masses(type_atom(i))*const_motion*(vel_atom(j,i)*vel_atom(j,i))
+                    end do
+                end if
+            end do
+        end if
+
+        if(ele_num > 0) then 
+            do ie = 1, ele_num_l
+                if(who_has_ele(ie).and.btest(e_mask(ie), g)) then 
+                    do inod = 1, ng_node(etype(ie))
+                        ip = cg_node(inod, ie)
+                        do ibasis = 1, basis_num(ie) 
+                            do j = 1, 3
+                                vel(j,ibasis,ip) = gasdev()        
+                                Kme = Kme + 0.5_wp * masses(basis_type(ibasis,ie))*const_motion &
+                                                   * mass_mat_coeff(size_ele(ie), etype(ie))*(vel(j,ibasis,ip)*vel(j,ibasis,ip)) 
+                            end do
+                        end do
+                    end do
+                end if
+            end do
+        end if
+
+        !Now sum all of the kinetic energies from all processors, calculate the scaling factor and apply it to the velocities
+        call mpi_allreduce(Kme, Kall, 1, mpi_wp, mpi_sum, world, ierr)
+        alpha=sqrt(Ktar(1)/Kall)
+        if(atom_num > 0) vel_atom = alpha*vel_atom
+        
+        if(ele_num > 0) then 
+            vel=alpha*vel
+            !Now communicate the element node velocities for shared elements
+            vel_buff = 0
+            do ie = 1, ele_num_l
+                if(who_has_ele(ie)) then 
+                    id = ele_glob_id(ie)
+                    do inod = 1, ng_node(etype(ie))
+                        ip = cg_node(inod, ie)
+                        do ibasis = 1, basis_num(ie)
+                            do j = 1, 3  
+                                vel_buff(3*(id-1)*ng_max_node*max_basisnum + 3*(inod-1)*max_basisnum + 3*(ibasis-1)+j) &
+                                = vel(j, ibasis, ip)
+                            end do
+                        end do
+                    end do
+                end if
+            end do
+
+            call mpi_allreduce(mpi_in_place, vel_buff, 3*ng_max_node*ele_num*max_basisnum, mpi_wp, mpi_sum, world, ierr)
+            do ie = 1, ele_num_l
+                id = ele_glob_id(ie)
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                        do j = 1, 3  
+                            vel(j, ibasis, ip) &
+                            =vel_buff(3*(id-1)*ng_max_node*max_basisnum + 3*(inod-1)*max_basisnum + 3*(ibasis-1)+j) 
+                        end do
+                    end do
+                end do
+            end do
+        end if
+
+    end subroutine init_vel
+
+
+    subroutine rescale_v
+    !rescale velocity
+    integer :: i, j, ibasis, ie
+    real(kind=wp) :: alpha, avg_vel(3), ke(2), rr, rsum, c1, c2, max_vel(3)
+
+
+    if (mod(iter, delay) == 0) then
+        !First calculate the kinetic energy 
+        avg_vel = compute_avgvel(gnum)
+        ke = compute_ke(gnum, avg_vel)
+
+        if(Nf(1) > 0) then 
+            if(rank == root) then 
+                !Sample the target kinetic energy from the canonical ensemble
+                if (is_equal(time_constant, 0.0_wp)) then 
+                    c1=0
+                else
+                    c1 = exp(-1/(time_constant))
+                end if
+                c2 = (1.0-c1)*Ktarget(2)/(ke(1))/(Nf(1))
+                rr = gasdev()
+                rsum = sumnoises(Nf(1)-1)
+                !This sampling formulation comes from:
+                !Bussi, Giovanni et al. "Canonical sampling through velocity rescaling" The Journal of Chemical Physics (2007)
+
+                alpha = sqrt(c1 + c2*(rr*rr + rsum) + 2.0_wp*rr*sqrt(c1*c2))
+            end if
+
+            call mpi_bcast(alpha, 1, mpi_wp, root, world, ierr)
+            
+
+            !Now rescale the velocities 
+
+            max_vel=0.0_wp
+            do i = 1, atom_num_l
+                do j = 1, 3
+                    vel_atom(j,i) = avg_vel(j) + alpha*(vel_atom(j,i)-avg_vel(j))
+                end do 
+                if(norm2(vel_atom(:, i)) > norm2(max_vel)) max_vel = vel_atom(:,i)
+            end do
+
+        end if
+
+        if (Nf(2) > 0) then 
+            if(rank == root) then 
+                !Sample the target kinetic energy from the canonical ensemble
+                if (is_equal(time_constant, 0.0_wp)) then 
+                    c1=0
+                else
+                    c1 = exp(-1/(time_constant))
+                end if
+                c2 = (1.0-c1)*Ktarget(3)/(ke(2))/(Nf(2))
+                rr = gasdev()
+                rsum = sumnoises(Nf(2)-1)
+                !This sampling formulation comes from:
+                !Bussi, Giovanni et al. "Canonical sampling through velocity rescaling" The Journal of Chemical Physics (2007)
+
+                alpha = sqrt(c1 + c2*(rr*rr + rsum) + 2.0_wp*rr*sqrt(c1*c2))
+            end if
+
+            call mpi_bcast(alpha, 1, mpi_wp, root, world, ierr)
+            do i = 1, node_num_l
+                ie = node_cg(i)
+                do ibasis=1, basis_num(ie)
+                    do j = 1, 3
+                        vel(j, ibasis, i) = avg_vel(j)+alpha*(vel(j,ibasis,i)-avg_vel(j))
+                    end do  
+                end do
+            end do
+        end if
+    end if
+    return
+    end subroutine rescale_v
+
+    
+
+    function sumnoises(nn)
+        !Returns the sum of n independent gaussian noises squared. This is equivalent to a chi-squared dist
+        implicit none
+        integer, intent(in) :: nn
+        real(kind=wp) :: sumnoises
+        
+        if (nn==0) then 
+            sumnoises=0.0_wp
+        else if (nn==1) then 
+            sumnoises=gasdev()**2.0_wp
+        else if (modulo(nn,2)==0) then 
+            sumnoises=2.0_wp*gamdev(nn/2)
+        else
+            sumnoises=2.0_wp*gamdev((nn-1)/2) + gasdev()**2.0_wp
+        end if
+    end function sumnoises
+
+    function gamdev(ia)
+        !gamma-distributed random number, implemented as described in numerical recipes
+
+        implicit none
+        integer, intent(in) :: ia
+        integer :: j
+        real(kind=wp) :: am, e, s, v1, v2, x, y, rand
+        real(kind=wp) :: gamdev
+
+        if(ia < 1) then 
+            print *, "Bad argument to function gamdev"
+            call mpi_abort(mpi_comm_world, 1, ierr)
+        else if (ia < 6) then 
+            x = 1
+            do j = 1, ia
+                call random_number(rand)
+                x = x*rand
+            end do
+
+            if( x < lim_small) then
+                x = 708.4
+            else
+                x = -log(x)
+            end if
+        else
+            do while(.true.)
+                call random_number(rand)
+                v1=rand
+                call random_number(rand)
+                v2=2.0_wp*rand-1.0_wp
+                if((v1*v1+v2*v2)>1.0_wp) cycle
+                y = v2/v1
+                am=ia-1
+                s=sqrt(2.0_wp*am+1.0_wp)
+                x=s*y+am
+                
+                if ( x <= 0) cycle 
+
+                if (((am*log(x/am)-s*y) < -700) .or.(v1<0.00001)) cycle
+                e = (1.0_wp + y**2.0_wp)*exp(am*log(x/am)-s*y)
+                call random_number(rand)
+                if(rand > e) cycle
+                exit 
+            end do
+        end if
+        gamdev=x
+    end function gamdev
+
+    function gasdev()                                                 
+        ! gaussian-distributed random number, implemented as described in numerical recipes
+        
+        implicit none
+        integer, save :: iset=0
+        real(kind=wp), save :: gset
+        real(kind=wp) :: rand, fac, rsq, v1, v2
+        real(kind=wp) gasdev
+
+        if(iset ==0) then 
+            do while(.true.)
+                call random_number(rand)
+                v1=2.0_wp*rand-1.0_wp
+                call random_number(rand)
+                v2=2.0_wp*rand-1.0_wp
+                rsq = v1**2.0_wp + v2**2.0_wp
+                if((rsq>=1.0_wp).or.((rsq>-lim_small).and.(rsq < lim_small))) then 
+                    cycle
+                else 
+                    exit
+                end if
+            end do
+            fac=sqrt(-2.0_wp*log(rsq)/rsq)
+            gset=v1*fac
+            gasdev=v2*fac
+            iset=1
+        else
+            gasdev=gset
+            iset=0
+        end if
+    end function gasdev
+
+    subroutine apply_perturbation
+        !This subroutine applies the appropriate perturbation to the interpolated atoms of an element
+            
+        integer :: ie, iatom, virt_count, iatomap, ibasis
+        real(kind = wp) :: bvec(3,3), r1, r2, r3, v(3), max_disp
+
+        max_disp = 0
+        do ie = 1, ele_num_l
+            select case(etype(ie))
+                case(1,2)
+                    virt_count = (size_ele(ie)+1)**3
+            end select
+
+            !First calculate the lattice basis vectors from the element nodal positions
+            bvec(:,1) = r(:,1,cg_node(2,ie)) - r(:,1, cg_node(1,ie))
+            bvec(:,2) = r(:,1,cg_node(4,ie)) - r(:,1, cg_node(1,ie))
+            bvec(:,3) = r(:,1,cg_node(5,ie)) - r(:,1, cg_node(1,ie))
+
+            !Now normalize the lattice vectors
+            bvec(:,1) = bvec(:,1)/norm2(bvec(:,1))
+            bvec(:,2) = bvec(:,2)/norm2(bvec(:,2))
+            bvec(:,3) = bvec(:,3)/norm2(bvec(:,3))
+
+            !Loop over all interpolated atoms 
+            do iatom = 1, virt_count
+                do ibasis = 1, basis_num(ie)
+                    iatomap = cg_atomap(basis_num(ie)*(iatom-1) + ibasis, ie)
+                    if (iatomap /= 0) then 
+                        !Get 3 random numbers 
+                        r1 = gasdev()
+                        r2 = gasdev()
+                        r3 = gasdev()
+
+                        !Now scale the lattice vectors by the gaussian number 
+                        v = 0.0_wp
+                        v = v+r1*bvec(:,1)
+                        v = v+r2*bvec(:,2)
+                        v = v+r3*bvec(:,3)
+
+                        !Add the vectors together to get the perturbation vector and then scale the magnitude to the mean sqaured
+                        !oscillation magnitude
+                        
+                        v = v*(urms(type_atomap(iatomap))/norm2(v))
+                        max_disp = norm2(v)
+
+                        r_atomap(:, iatomap) = r_atomap(:, iatomap) + v
+                    end if
+                end do
+            end do  
+        end do 
+
+    end subroutine apply_perturbation 
+end module temp

src/thermo.f90

@@ -0,0 +1,165 @@
+module thermo
+    !this is similar to the lammps thermo output which logs simulation information 
+    use elements
+    use forces
+    use compute
+    use str
+
+    implicit none
+
+
+    integer :: thermo_every, thermo_style_num
+    character(len=read_len) :: thermo_style(100)
+    logical :: need_k, need_t, need_p
+
+    public
+    contains
+
+    subroutine thermo_defaults
+        thermo_every = huge(1)
+        thermo_style_num = 2 
+        thermo_style(1) = "pe"
+        thermo_style(2) = "fnorm"
+        need_k = .false.
+        need_t = .false.
+        need_p = .false.
+    end subroutine thermo_defaults
+
+    subroutine parse_thermo_style(line)
+        !This subroutine parses the thermo style command
+        character(len=*), intent(in) :: line
+        integer :: iospara, i
+
+        character(len=read_len) :: tmptxt
+
+        thermo_style_num = tok_count(line)-1
+
+        need_k = .false.
+        need_t = .false.
+        need_p = .false.
+        read(line, *, iostat=iospara) tmptxt, (thermo_style(i), i=1, thermo_style_num)
+
+        !Now loop over all of the thermo_style items to make sure that they are acceptable
+        do i= 1, thermo_style_num
+            select case(thermo_style(i))
+                case('pe','fnorm', 'lx', 'ly', 'lz')
+                    continue
+                case('ke','ke_c','ke_a')
+                    need_k = .true.
+                case('temp', 'temp_c', 'temp_a')
+                    need_k = .true.
+                    need_t = .true.
+                case('px', 'py', 'pz')
+                    need_p = .true.
+                case default
+                    write(tmptxt, *) trim(adjustl(thermo_style(i))), " is not an acceptable thermostyle command, please check " //&
+                                   " the documentation for acceptable commands."    
+            end select
+        end do
+    end subroutine parse_thermo_style
+
+    subroutine parse_thermo(line)
+        !This subroutine parses the thermo command
+        character(len=*) :: line
+        character(len = read_len) :: tmptxt  
+        integer :: iospara
+
+        read(line, *, iostat = iospara) tmptxt, thermo_every 
+        if (iospara > 0) call read_error("Failure to read thermo command", iospara)
+
+        !Make sure thermo_every is greater than 0
+        if(thermo_every < 0) call misc_error("Thermo_every should be greater than 0 in thermo command")
+
+        if(thermo_every == 0) then 
+            thermo_every = huge(1)
+        end if
+
+    end subroutine parse_thermo
+
+    subroutine write_thermo_style
+        integer :: i
+        character(len=read_len) :: style_out
+
+        write(style_out, *) "thermo: ", (trim(adjustl(thermo_style(i)))//" ", i = 1, thermo_style_num)
+        call log_msg(style_out, 0)
+
+    end subroutine write_thermo_style
+
+    subroutine write_thermo_out(time)
+        !Preliminary write thermo out
+        integer, intent(in) :: time
+        integer :: i
+        real(kind=wp) :: ke(2), T(3), thermo_out(100), P(3,3)
+        character(len=read_len) :: msg
+
+        thermo_out = 0.0_wp
+
+        !Calculate temp, ke, and press if needed
+         if(need_k) then 
+            if(need_vel) then
+                ke = compute_ke(1)
+            else
+                ke = 0.0_wp
+            end if
+        end if
+        if(need_t) then 
+            if(need_vel) then 
+                T = compute_temp(1, ke)
+            else
+                T = 0.0_wp
+            end if
+        end if       
+
+        if(need_p) P = compute_box_press()
+
+        !Loop over all thermo_style commands and put the desired outputs into thermo_out
+        do i= 1, thermo_style_num
+            select case(thermo_style(i))
+            case('pe')
+                !Get pe all
+                thermo_out(i) = compute_pe(1)
+
+            case('fnorm')
+                !Get fnorm all
+                thermo_out(i) = compute_fnorm(1)
+
+            case('ke')
+                thermo_out(i) = ke(1) + ke(2)
+            case('ke_a')
+                thermo_out(i) = ke(1)
+            case('ke_c')
+                thermo_out(i) = ke(2)
+
+            case('temp')
+                thermo_out(i) = T(1)
+            case('temp_a')
+                thermo_out(i) = T(2)
+            case('temp_c')
+                thermo_out(i) = T(3)
+
+            case('lx')
+                thermo_out(i) = box_bd(2) - box_bd(1)
+            case('ly')
+                thermo_out(i) = box_bd(4) - box_bd(3)
+            case('lz')
+                thermo_out(i) = box_bd(6) - box_bd(5)
+
+            case('px')
+                thermo_out(i) = P(1,1)
+            case('py')
+                thermo_out(i) = P(2,2)
+            case('pz')
+                thermo_out(i) = P(3,3)
+
+            end select
+
+        end do
+        
+        if(rank == root) then 
+            write(msg,*) time, thermo_out(1:thermo_style_num)
+            call log_msg(msg)
+        end if
+        
+        return
+    end subroutine write_thermo_out
+end module thermo

src/time.f90

@@ -0,0 +1,50 @@
+module time
+    use parameters
+    use logger
+    use errors
+    use mpi
+
+    implicit none
+    !This subroutine contains variables and subroutines associated with timestepping
+    !also contains code for timing
+    
+    integer :: itime_start, iter, run_steps, begin_step
+    real(kind=wp) :: t, time_step, orig_time_step
+    real(kind=wp) :: walltime(2), program_start, program_end
+    
+    public 
+    contains
+
+    subroutine time_defaults
+        t = 0.0_wp
+        time_step = 0.001_wp
+        iter = 0
+        orig_time_step = 0.001_wp
+        walltime=0.0_wp
+    end subroutine time_defaults
+
+    subroutine parse_timestep(line)
+        character(len=*), intent(in) :: line
+        character(len=read_len) :: tmptxt
+        integer :: iospara
+
+        read(line, *, iostat = iospara) tmptxt, time_step
+
+        if(time_step <= 0.0_wp) then 
+            call misc_error("time step must be greater than 0")
+        end if
+
+        orig_time_step = time_step
+    end subroutine parse_timestep
+
+    subroutine log_time
+        character(len=read_len) :: msg
+
+        program_end = mpi_wtime()
+        write(msg, *) walltime(1), " spent neighboring and ", walltime(2), " spent computing forces"
+        call log_msg(msg)
+        write(msg, *) "Total time is:", program_end - program_start 
+        call log_msg(msg)
+    end subroutine log_time
+
+end module time

src/vel_verlet.f90

@@ -0,0 +1,109 @@
+module vel_verlet
+    !This module contains all the code for running steps of the verlet algorithm
+    !This is equivalent to the NVE ensemble
+    use parameters
+    use comms 
+    use elements
+    use neighbors 
+    use potential
+    use time
+
+    implicit none
+
+    public
+    contains
+
+    subroutine verlet(i)
+        integer, intent(in) :: i
+        !This subroutine advances the model by 1 timestep using the velocity verlet algorithm
+        !Update position at time i+1
+        call update_r
+        !Update neighbor at time i+1
+        call update_neighbor(i)
+        !Update neighbor at time i+1
+        call update_force
+        !Update velocity at time i+1
+        call update_vel(time_step)
+    end subroutine verlet
+
+    subroutine update_r
+        !This subroutine updates the positions for all atoms and coarse-grained element nodes
+        
+        integer :: ia, ip, ibasis
+
+        if(ele_num /= 0) then 
+            do ip = 1, node_num_l
+                do ibasis = 1, basis_num(node_cg(ip))
+                    r(:,ibasis,ip) = r(:, ibasis, ip) + vel(:, ibasis, ip) * time_step &
+                                    + 0.5_wp * force_eq(:, ibasis, ip)/ masses(basis_type(ibasis,node_cg(ip))) &
+                                    * time_step**2.0_wp / const_motion
+                end do
+            end do
+            force_eq_pre(:,:,1:node_num_l) = force_eq(:,:,1:node_num_l)
+        end if
+
+        if(atom_num /= 0) then 
+            do ia = 1, atom_num_l
+                r_atom(:,ia) = r_atom(:,ia) + vel_atom(:, ia)*time_step + 0.5_wp*force_atom(:,ia)/masses(type_atom(ia)) &
+                              * time_step**2.0_wp / const_motion  
+            end do
+            force_atom_pre(:,1:atom_num_l) = force_atom(:, 1:atom_num_l)
+
+        end if
+
+        return
+    end subroutine update_r
+
+    subroutine update_vel(time_step)
+        real(kind=wp), intent(in) :: time_step
+        !update the velocity
+        integer :: ie, inod, ip, ia, ibasis
+        real(kind = wp) :: pro_force_normsq, avg(3) 
+
+        pro_force_normsq = 0.0_wp
+        if(ele_num /= 0) then
+            do ie = 1, ele_num_l
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                        vel(:, ibasis, ip) = vel(:, ibasis, ip) + 0.5_wp * (force_eq_pre(:, ibasis, ip) &
+                                             + force_eq(:, ibasis, ip)) / masses(basis_type(ibasis,ie)) &
+                                             * time_step / const_motion
+                    end do
+                end do
+            end do
+        end if
+
+        !atomistic domain
+        if(atom_num /= 0) then
+            do ia = 1, atom_num_l
+                vel_atom(:, ia) = vel_atom(:, ia) + 0.5_wp * (force_atom_pre(:, ia) &
+                                + force_atom(:, ia)) / masses(type_atom(ia)) &
+                                * time_step / const_motion
+            end do
+
+        end if
+
+        !Now take out the average velocity
+        avg = compute_avgvel(1)
+        if(ele_num > 0) then 
+            do ie = 1, ele_num_l
+                do inod = 1, ng_node(etype(ie))
+                    ip = cg_node(inod, ie)
+                    do ibasis = 1, basis_num(ie)
+                        vel(:, ibasis, ip) = vel(:, ibasis, ip) - avg
+                    end do
+                end do
+            end do
+        end if
+
+        !atomistic domain
+        if(atom_num /= 0) then
+            do ia = 1, atom_num_l
+                vel_atom(:, ia) = vel_atom(:, ia) - avg
+            end do
+
+        end if
+
+    end subroutine update_vel
+end module vel_verlet