write_coord Subroutine

public subroutine write_coord(mol, unit)

Arguments

Type IntentOptional Attributes Name
class(structure_type), intent(in) :: mol
integer, intent(in) :: unit

Source Code

subroutine write_coord(mol, unit)
   class(structure_type), intent(in) :: mol
   integer, intent(in) :: unit
   integer :: iat, ilt, npbc
   logical :: expo

   real(wp) :: conv_fac
   logical :: angs

   angs = mol%info%angs_coord
   conv_fac = 1.0_wp
   if (angs) conv_fac = autoaa

   if (angs) then
      write(unit, '(a)') "$coord angs"
   else
      write(unit, '(a)') "$coord"
   end if
   expo = maxval(mol%xyz) > 1.0e+5 .or. minval(mol%xyz) < -1.0e+5
   if (expo) then
      do iat = 1, mol%nat
         write(unit, '(3es24.14, 6x, a)') mol%xyz(:, iat) * conv_fac, &
            trim(mol%sym(mol%id(iat)))
      end do
   else
      do iat = 1, mol%nat
         write(unit, '(3f24.14, 6x, a)') mol%xyz(:, iat) * conv_fac, &
            trim(mol%sym(mol%id(iat)))
      end do
   end if
   if (any([nint(mol%charge), mol%uhf] /= 0)) then
      write(unit, '(a, *(1x, a, "=", i0))') &
         "$eht", "charge", nint(mol%charge), "unpaired", mol%uhf
   end if
   if (any(mol%periodic)) then
      write(unit, '(a, 1x, i0)') "$periodic", count(mol%periodic)
      npbc = count(mol%periodic)
      if (size(mol%lattice, 2) == 3) then
         if (angs) then
            write(unit, '(a)') "$lattice angs"
         else
            write(unit, '(a)') "$lattice bohr"
         end if
         do ilt = 1, npbc
            write(unit, '(3f20.14)') mol%lattice(:npbc, ilt) * conv_fac
         end do
      end if
   end if
   write(unit, '(a)') "$end"

end subroutine write_coord