Create a copy of reference geometry with one coordinate displaced
Args: reference_geom: Original geometry to copy atom_idx: Atom to displace (1-based) coord_idx: Coordinate to displace (1=x, 2=y, 3=z) displacement: Amount to displace in Bohr (positive or negative) displaced_geom: Output displaced geometry
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(physical_fragment_t), | intent(in) | :: | reference_geom | |||
| integer, | intent(in) | :: | atom_idx | |||
| integer, | intent(in) | :: | coord_idx | |||
| real(kind=dp), | intent(in) | :: | displacement | |||
| type(physical_fragment_t), | intent(out) | :: | displaced_geom |
subroutine copy_and_displace_geometry(reference_geom, atom_idx, coord_idx, displacement, displaced_geom) !! Create a copy of reference geometry with one coordinate displaced !! !! Args: !! reference_geom: Original geometry to copy !! atom_idx: Atom to displace (1-based) !! coord_idx: Coordinate to displace (1=x, 2=y, 3=z) !! displacement: Amount to displace in Bohr (positive or negative) !! displaced_geom: Output displaced geometry type(physical_fragment_t), intent(in) :: reference_geom integer, intent(in) :: atom_idx, coord_idx real(dp), intent(in) :: displacement type(physical_fragment_t), intent(out) :: displaced_geom ! Copy basic properties displaced_geom%n_atoms = reference_geom%n_atoms displaced_geom%charge = reference_geom%charge displaced_geom%multiplicity = reference_geom%multiplicity displaced_geom%nelec = reference_geom%nelec displaced_geom%n_caps = reference_geom%n_caps ! Allocate and copy arrays allocate (displaced_geom%element_numbers(displaced_geom%n_atoms)) allocate (displaced_geom%coordinates(3, displaced_geom%n_atoms)) displaced_geom%element_numbers = reference_geom%element_numbers displaced_geom%coordinates = reference_geom%coordinates ! Copy hydrogen cap information if present if (reference_geom%n_caps > 0) then allocate (displaced_geom%cap_replaces_atom(displaced_geom%n_caps)) displaced_geom%cap_replaces_atom = reference_geom%cap_replaces_atom end if ! Copy gradient redistribution mapping if present if (allocated(reference_geom%local_to_global)) then allocate (displaced_geom%local_to_global(size(reference_geom%local_to_global))) displaced_geom%local_to_global = reference_geom%local_to_global end if ! Apply displacement to specified coordinate displaced_geom%coordinates(coord_idx, atom_idx) = & displaced_geom%coordinates(coord_idx, atom_idx) + displacement ! Copy basis set if present (same basis, just different geometry) if (allocated(reference_geom%basis)) then ! Note: Basis set will need to be rebuilt with new coordinates ! For now, we don't copy it - it should be set up during calculation end if end subroutine copy_and_displace_geometry