module fodmc_mod
  
contains
subroutine get_guess(output_mode,output_name)

!program fodMC

! Copyright    2019    Kai Trepte
! 
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
! 
! http://www.apache.org/licenses/LICENSE-2.0
! 
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License






! Author: Kai Trepte
! Idea Alex Johnson: Introduce a connectivity matrix to describe how many bonds each atom 
!                    has to each other atom, create FODs accordingly
!                    Input: Connectivity pattern and number of UP and DN lone FODs
! Idea Jakob Krause: Initialize single bonds according to covalent radii of the atoms.
! 
! Version 1
! 12. November 2018
! NEW: No input for H atoms needed anymore
! Version 2
! 21. January 2019
! Change of user input towards a simpler description of the bond pattern. Idea: (center1-center2)-(UP_FODS_in_bond-DN_FODS_in_bond)  for all pairs of atoms which have a bond. Lone FODs are specified afterwards
! 22. January 2019
! Exclude explicit need for X-H bonds. They can be introduced, but automatically it will always be a (1-1) bond
! In addition, lone FODs are now only necessary to place for atoms which actually have lone FODs
! 23. January 2019
! This is a test: Introduce cutoff radius. Set bond order of all pairs of atoms to 1 (1-1). With that, only bonds which are not single bonds need to be specified.
! 05. February 2019
! Rotate double bonds in linear molecules against each other (e.g. Lewis structure of CO2)
! 08. February 2019
! More consistent treatment of initial points for lone-FODs (now scaled with (FOD_UP+FOD_DN)/2)
! Point charge dipole as output (excluding 1s core-FODs)
! Change initial assessment of single bonds via covalent radii of the elements (Thanks to Jakob Krause) - revoke changes from 23. January
! Initial lone FODs are place per atom assuming charge neutrality of the system. Taking the bond information into account.
! 11. February 2019
! Read number of core FODs as input. Necessary to get the initial lone-FOD setting universally applicable.
! 11. March 2019
! Simplify structured. Avoid double counting as much as possible. Few instances where this is possible right now
! Implemented PBCs (periodic boundary conditions). Read in a key word. If it is 'pbc', then read coordinates, cell vectors and bond matrix
! 18. March 2019
! Simplify the specification for different amount of UP and DN bond FODs. Now, the specification (45-31)-(3-2) will automatically assign the correct number of bond FODs between the atoms, regardless of their order
! 19. March 2019
! New determination whether atoms are in a planar or linear environment. Much clearer now
! 13. May 2019
! Introduce 'fix1s' option. Allows to place all 1s FODs at the atomic positions
! 15. May 2019
! Re-introduced the distribution of points on a sphere
! 24. May 2019
! Introduce structural motifs. Use these for atoms and core FODs. Thus, no distribution of 
! points on a sphere necessary for such FODs.
! 22. May 2020
! Incorporate xx_database_xx into this file as a subroutine.
! 06. September 2019
! Starting implementing symmetry-adapted FODs. Make the FODs as symmetric as possible.
! Symmetrize lone FODs with respect to bond FODs. (01. December, 2019)
! TBD: Symmetrize bond FODs with respect to bond FODs. 
! TBD: Symmetrize lone FODs with respect to lone FODs in single bonded situations. 
! TBD: Symmetrize core FODs with respect to valence FODs.
! 29. October 2019
! Idea: Place bond FODs closer to the atom with larger electronegativity -> better start points? TBD
! 05. February 2020
! Make analysis of planarity more robust. I.e. it should not depend on the order of the atoms.
! Once analyzed, check not just one atom, but both atoms involved in the bond. If either is in a planar environment ->
! move FODs out of plane. Thin about this!
! 05. November 2020
! Add output_mode and output_name for better output handling

implicit none
! Output handling
character(len=*), intent(in)   :: output_mode, output_name                ! Mode for output (NRLMOL = CLUSTER+FRMORB, PyFLOSIC = name.xyz)

! new array structure: 3 real     (coordinates of center)
!		       1 char	  (element symbols)
!                      1 integer  (shell number)
!                      1 integer  (points on the shells)
!                      3 real     (r, theta, phi of the point)
!                      3 real     (x, y, z       of the point)
type global_array
  real(8)              :: center_x_y_z(3)                         ! atomic positions
  character(len=17)    :: elements                                ! element symbols.
  integer              :: n_shells                                ! Number of shells
  integer, allocatable :: n_points(:)                             ! dimensions: n_shells
  real(8), allocatable :: r_theta_phi(:,:,:)                      ! dimensions: n_shells, n_points, 3
  real(8), allocatable :: point_x_y_z(:,:,:)                      ! dimensions: n_shells, n_points, 3
end type global_array
type(global_array), dimension(:), allocatable :: pos1_up          ! global_array(1) - first center, global_array(2) - second center, ...
type(global_array), dimension(:), allocatable :: pos1_dn      
type(global_array), dimension(:), allocatable :: pos2_up          ! 1 - before MC step, 2 - after MC step
type(global_array), dimension(:), allocatable :: pos2_dn      


! Used for assessment of input data and to write output to the screen
integer                        :: number_of_centers ! number of different centers/ different atoms
integer, allocatable           :: element_number(:) ! order number per element. Used for writing CLUSTER
integer, allocatable           :: pseudo_charge(:)  ! number of core-electrons which are not treated explicitely (pseudopotentials)
integer, allocatable           :: core_charge(:)    ! number of core-electrons in total 
real(8)                        :: charge, spin      ! numbers to store charge and spin of the system
real(8), allocatable           :: covalent_R(:)     ! list covalent radii
character(len=2), allocatable  :: element_symbol(:) ! element symbols
character(len=4), allocatable  :: element_count(:)  ! number of specific type of element
logical                        :: periodic          ! keywords determining whether PBCs shall be used or not
logical                        :: fix1s             ! keywords determining whether to fix the 1s FODs at the nuclei
real(8)                        :: cell_a(3), cell_b(3), cell_c(3)   ! unit cell vectors. In case of PBCs
real(8)                        :: len_a, len_b, len_c, V_tot        ! length of unit cell vectors and total volume of the unit cell. In case of PBCs
real(8)                        :: angle_ab, angle_bc,  angle_ac     ! angles between unit cell vectors. In case of PBCs
character(len=1000)            :: bla2
character(len=25)              :: formatBLA
character(len=25)              :: formatBLA2

! Reading database -> need junk
character(len=17)              :: junk, junk2
character(len=8)               :: units             ! either bohr or angstrom . 
real(8)                        :: units_factor      ! conversion factor to bohr. 

! Used for evaluation
real(8)              :: ave_dist1_up_core, ave_dist2_up_core  ! average distances or 1/r. Before and after MC step. UP channel. For core FODs
real(8)              :: ave_dist1_dn_core, ave_dist2_dn_core  ! average distances or 1/r. Before and after MC step. DN channel. For core FODs
real(8)              :: ave_dist1_up, ave_dist2_up            ! average distances or 1/r. Before and after MC step. UP channel. For all or valence FODs
real(8)              :: ave_dist1_dn, ave_dist2_dn            ! average distances or 1/r. Before and after MC step. DN channel. For all or valence FODs
real(8)              :: ave_dist1, ave_dist2                  ! average distances or 1/r. Before and after MC step. Globally
real(8)              :: tmp_dist                              ! temporary distance for evaluation using PBCs
integer              :: cycles                                ! maximum number of steps     
real(8)              :: step_size                             ! maximal step size per point
integer              :: a,b,c,d,e,f,g,h,i,j,t                 ! loop variable
real(8)              :: start_t, finish_t                     ! start and finish time
real(8)              :: d_bond                                ! distance to closest atom
real(8)              :: scale_r                               ! scaling factor for the determination of where to place multiple FODs
integer              :: counter_up, counter_dn, counter       ! counter. To count things
integer              :: counter2                              ! counter. Lone FODs. 
real(8)              :: full_rot(3,3)                         ! rotation matrix  rot_x(3,3), rot_y(3,3), rot_z(3,3)
real(8), parameter   :: pi = 4.0D0*atan(1.0D0)                ! define pi.
real(8)              :: angle                                 ! rotation angle
real(8)              :: dist1, dist2                          ! distance of FODs to atoms. Use to evaluate bond FODs in the symmetrization of lone FODs
real(8)              :: dip_x, dip_y, dip_z                   ! point charge dipole in x, y, z
real(8)              :: cent_x, cent_y, cent_z                ! center of molecule/cell. For dipole evaluation
! Used for the connectivity matrix
character(len=99), allocatable :: bond_pattern(:)             ! bond pattern to be read in (NOT including lone pairs)
character(len=15)    :: bond_centers, bond_fods               ! for each individual entry of centers and FODs
integer, allocatable :: con_mat(:,:)                          ! connectivity matrix between all atoms. Order N x N
integer, allocatable :: lone_fods(:,:)                        ! number of UP and DN lone FODs per atom
real(8)              :: bond_center(3)                        ! position of the bond center between two atoms
real(8)              :: bond_vector(3)                        ! vector describing the bond
real(8), allocatable :: tmp_vectors(:,:)                      ! bond vector in case of a planar molecule -> get normal vector by cross product
real(8)              :: tmp_vector(3)                         ! tmeporary vector
real(8)              :: perpendicular_vec(3)                  ! vector perpedicular to the bond vector
real(8)              :: perpendicular_vec_motif(3)            ! vector perpedicular to the structural motif under consideration
integer, allocatable :: bond_count_up(:)                      ! counting the number of bonds already assumed by an atom -> assign valence properly. 
integer, allocatable :: bond_count_dn(:)                      ! counting the number of bonds already assumed by an atom -> assign valence properly.
real(8), allocatable :: r_tmp_up(:)                           ! temporary arrays to store radii of all shells from the database
real(8), allocatable :: r_tmp_dn(:)
integer, allocatable :: N_tmp_up(:)                           ! temporary arrays to store number of all shells from the database
integer, allocatable :: N_tmp_dn(:)
! Used for Metropolis
real(8)              :: rand_metro                            ! random number for optimization with metropolis algorithm 

! for planarity/linearity
integer, allocatable :: is_planar_linear(:)                   ! determine whether there are planar/linear elements in a molecule. Necessary for bond and lone FOD generation

! for random seed
integer                             :: values(1:8), k
integer, dimension(:), allocatable  :: seed
call date_and_time(values=values)
call random_seed(size=k)
allocate(seed(1:k))
seed(:) = values(8)
call random_seed(put=seed)
! end for random seed



!!!!!!!!!
! START !
!!!!!!!!!
!!!!!!!!!!!!!!!!!!
! Read in values !
!!!!!!!!!!!!!!!!!!
open(unit=17,file='system',status='old',action='read')

read(17,*) number_of_centers                                                    ! read number of centers and allocate the global arrays
allocate(pos1_up(number_of_centers))
allocate(pos2_up(number_of_centers))
allocate(pos1_dn(number_of_centers))
allocate(pos2_dn(number_of_centers))
allocate(element_number(number_of_centers))
allocate(pseudo_charge(number_of_centers))
allocate(core_charge(number_of_centers))

read(17,*) units, junk, junk2                                                   ! read in the unit to be used (angstrom or bohr). and whether PBCs shall be used or not. And whether to fix the 1s FODs at the origin
if ((units == 'angstrom') .or. (units == 'Angstrom')) then
  units_factor = 0.529177D0
else if ((units == 'bohr') .or. (units == 'Bohr')) then
  units_factor = 1.000000D0
else
  write(6,*) 'Specified unit is neither angstrom nor bohr. Please check the second line of the file "system"'
  stop
end if
!
! If PBCs and/or fixing 1s at the nuclear positions
!
if ((junk == 'pbc' .and. junk2 == 'fix1s') .or. (junk == 'fix1s' .and. junk2 == 'pbc')) then
  periodic = .true.
  fix1s = .true.
else if (junk == 'pbc') then
  periodic = .true.
  fix1s = .false.
  backspace(17)                                                                ! If one of the keywords is missing -> need to go one line back up
else if (junk == 'fix1s') then
  periodic = .false.
  fix1s = .true.
  backspace(17)                                                                ! If one of the keywords is missing -> need to go one line back up
else
  periodic = .false.
  fix1s = .false.
  backspace(17)                                                                ! If both keywords are missing -> need to go one line back up
end if

do a = 1, number_of_centers
  read(17,*) pos1_up(a)%elements, pos1_up(a)%center_x_y_z(1:3)                 ! coordinates of atoms and element symbols. Same for all global arrays
  pos2_up(a)%elements = pos1_up(a)%elements
  pos1_dn(a)%elements = pos1_up(a)%elements
  pos2_dn(a)%elements = pos1_up(a)%elements
  pos2_up(a)%center_x_y_z(1:3) = pos1_up(a)%center_x_y_z(1:3)
  pos1_dn(a)%center_x_y_z(1:3) = pos1_up(a)%center_x_y_z(1:3)
  pos2_dn(a)%center_x_y_z(1:3) = pos1_up(a)%center_x_y_z(1:3)
end do
if (periodic) then                                                             ! in case of periodic boundary conditions: Read cell vectors
  read(17,*)                                                                   ! skip line after the atomic coordinates.
  read(17,*) cell_a(1), cell_a(2), cell_a(3)
  read(17,*) cell_b(1), cell_b(2), cell_b(3)
  read(17,*) cell_c(1), cell_c(2), cell_c(3)
end if


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! FOR ATOMS ONLY                         !
! if n = 1 -> read from xx_database_xx.  !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if (number_of_centers == 1) then
  allocate(covalent_R(number_of_centers))
  a = 1                                                                         ! index for the atoms. 1 in this case

  ! Temporary array to store number of shells and radii for all shells. 
  ! Later, they will be transfered into the corresponding arrays
  ! 10 ... there is no element with that many shells. So this is just a temporary number
  allocate(r_tmp_up(10))
  allocate(r_tmp_dn(10))
  allocate(N_tmp_up(10))
  allocate(N_tmp_dn(10))
  r_tmp_up(:) = 0.0D0
  r_tmp_dn(:) = 0.0D0
  N_tmp_up(:) = 0.0D0
  N_tmp_dn(:) = 0.0D0

  call database(pos1_up(a)%elements,element_number(a),pseudo_charge(a), &  ! get all initial data
                core_charge(a), covalent_R(a), &
                pos1_up(a)%n_shells, pos1_dn(a)%n_shells, &
                N_tmp_up,N_tmp_dn,r_tmp_up,r_tmp_dn)

  pos2_up(a)%n_shells = pos1_up(a)%n_shells                                ! define the number of shells for the second arrays
  pos2_dn(a)%n_shells = pos1_dn(a)%n_shells                                ! 
  allocate(pos1_up(a)%n_points(pos1_up(a)%n_shells))
  allocate(pos1_dn(a)%n_points(pos1_dn(a)%n_shells))
  allocate(pos2_up(a)%n_points(pos2_up(a)%n_shells))
  allocate(pos2_dn(a)%n_points(pos2_dn(a)%n_shells))

  ! store number of points for the different shells
  do b = 1, pos1_up(a)%n_shells                                            ! store the number of points for all shells, spin UP
    pos1_up(a)%n_points(b) = N_tmp_up(b)
    pos2_up(a)%n_points(b) = pos1_up(a)%n_points(b)
  end do
  do b = 1, pos1_dn(a)%n_shells                                            ! store the number of points for all shells, spin DN
    pos1_dn(a)%n_points(b) = N_tmp_dn(b)
    pos2_dn(a)%n_points(b) = pos1_dn(a)%n_points(b)
  end do

  ! allocate all needed arrays
  allocate(pos1_up(a)%r_theta_phi(pos1_up(a)%n_shells,sum(pos1_up(a)%n_points(:)),3))
  allocate(pos2_up(a)%r_theta_phi(pos2_up(a)%n_shells,sum(pos2_up(a)%n_points(:)),3))
  allocate(pos1_dn(a)%r_theta_phi(pos1_dn(a)%n_shells,sum(pos1_dn(a)%n_points(:)),3))
  allocate(pos2_dn(a)%r_theta_phi(pos2_dn(a)%n_shells,sum(pos2_dn(a)%n_points(:)),3))
  allocate(pos1_up(a)%point_x_y_z(pos1_up(a)%n_shells,sum(pos1_up(a)%n_points(:)),3))
  allocate(pos2_up(a)%point_x_y_z(pos2_up(a)%n_shells,sum(pos2_up(a)%n_points(:)),3))
  allocate(pos1_dn(a)%point_x_y_z(pos1_dn(a)%n_shells,sum(pos1_dn(a)%n_points(:)),3))
  allocate(pos2_dn(a)%point_x_y_z(pos2_dn(a)%n_shells,sum(pos2_dn(a)%n_points(:)),3))

  ! store the radii of for the different shells 
  ! INITIALIZE THE POINTS !
  do b = 1, pos1_up(a)%n_shells
    pos1_up(a)%r_theta_phi(b,1,1) = r_tmp_up(b)*units_factor    ! convert to correct units
  
    do c = 1, pos1_up(a)%n_points(b)                            ! store all other values for this shell accordingly. Add theta and phi.
      pos1_up(a)%r_theta_phi(b,c,1:3) = (/ pos1_up(a)%r_theta_phi(b,1,1), real(pi/2.0,8), real(0.0,8) /)
      pos2_up(a)%r_theta_phi(b,c,1:3) = pos1_up(a)%r_theta_phi(b,c,1:3)
      pos1_up(a)%point_x_y_z(b,c,1:3) = (/ pos1_up(a)%r_theta_phi(b,1,1) + pos1_up(a)%center_x_y_z(1), &
                                         & pos1_up(a)%center_x_y_z(2),     pos1_up(a)%center_x_y_z(3) /)
      pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
    end do
  end do
  do b = 1, pos1_dn(a)%n_shells
    pos1_dn(a)%r_theta_phi(b,1,1) = r_tmp_dn(b)*units_factor    ! convert to correct units
    do c = 1, pos1_dn(a)%n_points(b)                                             ! store all other values for this shell accordingly. Add theta and phi.
      pos1_dn(a)%r_theta_phi(b,c,1:3) = (/ pos1_dn(a)%r_theta_phi(b,1,1), real(pi/2.0,8), real(0.0,8) /)
      pos2_dn(a)%r_theta_phi(b,c,1:3) = pos1_dn(a)%r_theta_phi(b,c,1:3)
      pos1_dn(a)%point_x_y_z(b,c,1:3) = (/ pos1_dn(a)%r_theta_phi(b,1,1) + pos1_dn(a)%center_x_y_z(1), &
                                         & pos1_dn(a)%center_x_y_z(2),     pos1_dn(a)%center_x_y_z(3) /)
      pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
    end do
  end do
  !
  ! Put all 1s core FODs (index (1,1,1:3)) at the origin
  ! If NOT pseudopotential
  !
  if ((fix1s).and.(pos1_up(a)%elements(3:5).ne.'ECP').and.(pos1_up(a)%elements(4:6).ne.'ECP')) then
    pos1_up(a)%r_theta_phi(1,1,1:3) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /) 
    pos1_up(a)%point_x_y_z(1,1,1:3) = pos1_up(a)%center_x_y_z(1:3)
    pos2_up(a)%r_theta_phi(1,1,1:3) = pos1_up(a)%r_theta_phi(1,1,1:3)
    pos2_up(a)%point_x_y_z(1,1,1:3) = pos1_up(a)%point_x_y_z(1,1,1:3)
    pos1_dn(a)%r_theta_phi(1,1,1:3) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /) 
    pos1_dn(a)%point_x_y_z(1,1,1:3) = pos1_dn(a)%center_x_y_z(1:3)
    pos2_dn(a)%r_theta_phi(1,1,1:3) = pos1_dn(a)%r_theta_phi(1,1,1:3)
    pos2_dn(a)%point_x_y_z(1,1,1:3) = pos1_dn(a)%point_x_y_z(1,1,1:3)
  end if

  ! Deallocate temporary arrays
  deallocate(r_tmp_up)
  deallocate(r_tmp_dn)
  deallocate(N_tmp_up)
  deallocate(N_tmp_dn)



!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! FOR MOLECULES -> read core radii from xx_database_xx, rest from system !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
else
! create connectivity matrix from bond pattern. Like (1-2)-(2-2) (1-4)-(1-1) (3-4)-(3-2)   
! atom 1 binds to atom 2 with 2-UP and 2DN FODS, 1 to atom 4 with 1-UP and 1-DN FOD and atom 3 to atom 4 with 3-UP and 2-DN FODs
! initialize con_mat and lone_fods with 0 everywhere                                       ! lone FODs will be initialized later
  allocate(con_mat(number_of_centers,number_of_centers))
  allocate(lone_fods(number_of_centers,2))
  allocate(bond_count_up(number_of_centers))
  allocate(bond_count_dn(number_of_centers))
  allocate(covalent_R(number_of_centers))

  con_mat(:,:)     = 0                                                         ! initialize all bonds to be 0
  lone_fods(:,:)   = 0                                                         ! initialize all lone FODs to be 0
  bond_count_up(:) = 1                                                         ! counting UP FODs in bonds for a given atom.
  bond_count_dn(:) = 1                                                         ! counting DN FODs in bonds for a given atom

  ! skip comment line
  read(17,*)
  !
  ! Read number of shells for all atoms
  !
  do a = 1, number_of_centers
    !
    ! Temporary array to store number of shells and radii for all shells. 
    ! Later, they will be transfered into the corresponding arrays
    ! 10 ... there is no element with that many shells. So this is just a temporary number
    !
    allocate(r_tmp_up(10))
    allocate(r_tmp_dn(10))
    allocate(N_tmp_up(10))
    allocate(N_tmp_dn(10))
    r_tmp_up(:) = 0.0D0
    r_tmp_dn(:) = 0.0D0
    N_tmp_up(:) = 0.0D0
    N_tmp_dn(:) = 0.0D0

    call database(pos1_up(a)%elements,element_number(a),pseudo_charge(a), &  ! get all initial data
                  core_charge(a), covalent_R(a), &
                  pos1_up(a)%n_shells, pos1_dn(a)%n_shells, &
                  N_tmp_up,N_tmp_dn,r_tmp_up,r_tmp_dn)

    pos2_up(a)%n_shells = pos1_up(a)%n_shells                                ! define the number of shells for the second arrays
    pos2_dn(a)%n_shells = pos1_dn(a)%n_shells                                ! 
    allocate(pos1_up(a)%n_points(pos1_up(a)%n_shells))
    allocate(pos1_dn(a)%n_points(pos1_dn(a)%n_shells))
    allocate(pos2_up(a)%n_points(pos2_up(a)%n_shells))
    allocate(pos2_dn(a)%n_points(pos2_dn(a)%n_shells))

    ! store number of points for the different shells
    do b = 1, pos1_up(a)%n_shells                                            ! store the number of points for all shells, spin UP
      pos1_up(a)%n_points(b) = N_tmp_up(b)
      pos2_up(a)%n_points(b) = pos1_up(a)%n_points(b)
    end do
    do b = 1, pos1_dn(a)%n_shells                                            ! store the number of points for all shells, spin DN
      pos1_dn(a)%n_points(b) = N_tmp_dn(b)
      pos2_dn(a)%n_points(b) = pos1_dn(a)%n_points(b)
    end do

    ! Deallocate temporary arrays
    deallocate(r_tmp_up)
    deallocate(r_tmp_dn)
    deallocate(N_tmp_up)
    deallocate(N_tmp_dn)
  end do
  !
  ! For bonds : simply add one FOD for all bonds. I.e. all bonds are initialized with single bonds
  !
  do a = 1, number_of_centers-1
    do b = a+1, number_of_centers
      if (periodic) then                                                       ! In a peridoic system, take cell vectors into account
        do c = 1, 3
          do d = 1, 3
            do e = 1, 3
              if (sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                           (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:))**2)) < &
                           (covalent_R(a)+covalent_R(b)+0.20)*units_factor) then
                con_mat(a,b) = 1
                con_mat(b,a) = 1
              end if
            end do
          end do
        end do
      else                                                                     ! For a non-periodic system, just evalaute the distances
        if (sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:))**2)) < &
                  & ((covalent_R(a)+covalent_R(b)+0.20)*units_factor)) then
          con_mat(a,b) = 1
          con_mat(b,a) = 1
        end if
      end if
    end do
  end do
  !
  ! Read rest of the input pattern regarding the bonding information
  !
  j = 0
  counter = 0 
  loop5: do a = 1, 1000                                                        ! if there is more than one input line -> go through all of them
    read(17,fmt='(A)') bla2
    if (bla2(1:1) == '(') then                                                 ! bond pattern always starts with a '(' 
      j = j + 1                                                                ! count number of entry lines
      do b = 1, len_trim(bla2)+1                                               ! read each string that contains the bonding information. Add one space to read last entry
        if (bla2(b:b) == ' ') then                                             ! if a space if found -> delimiter
          counter = counter + 1                                                ! counter is increased
        end if
      end do
    else
      exit loop5
    end if
  end do loop5
  !
  ! Allocate array according to the counter
  !
  allocate(bond_pattern(counter))
  !
  ! go back to the first input line. j+1 because in the above loop we read the input line and then increase the counter. Thus, it is increase one time too much
  !
  do a = 1, j + 1
    backspace(17)
  end do
   
  counter = 0
  do a = 1, j                                                                  ! go through the number of input lines
    read(17,fmt='(A)') bla2
    c = 0
    do b = 1, len_trim(bla2)+1                                                 ! read each string that contains the bonding information. Add one space to read last entry
      if (bla2(b:b) == ' ') then                                               ! if a space if found -> delimiter
        counter = counter + 1                                                  ! counter is increased
        bond_pattern(counter) = bla2(c+1:b-1)                                  ! store bond pattern
        c = b                                                                  ! increase the index of the string in total. Read all entries individually
      end if
    end do
  end do
  !
  ! CONSTRUCT CON_MAT AND LONE_FODS
  !
  do b = 1, counter                                                            ! for each entry of the bond pattern, iterate through all entries
    do c = 1, len(trim(bond_pattern(b)))                                       ! for each individual entry
      if (bond_pattern(b)(c:c) == '-' .and. bond_pattern(b)(c-1:c-1) == ')' .and. bond_pattern(b)(c+1:c+1) == '(') then   ! delimiter between centers and FOD information
        read(bond_pattern(b)(2:c-2),fmt='(A)') bond_centers
        read(bond_pattern(b)(c+2:len(trim(bond_pattern(b)))-1),fmt='(A)') bond_fods
        !
        ! go through the bond centers and assign variables to them accordingly
        !
        do d = 1, len(trim(bond_centers))
          if (bond_centers(d:d) == '-') then                                   ! found delimiter -> read in the atomic index per center involved in the bond
            read(bond_centers(1:d-1),fmt='(I4)') e                             ! bond center 1
            read(bond_centers(d+1:len(trim(bond_centers))),fmt='(I4)') f       ! bond center 2
          end if
        end do
        !
        ! now, go through the corresponding number of bond FODs (UP, DN) and write con_mat
        !
        do d = 1, len(trim(bond_fods))
          if (bond_fods(d:d) == '-') then                                      ! found delimiter -> read in the number of UP and DN FODs in the bond and write con_mat
            read(bond_fods(1:d-1),fmt='(I4)') g                                ! UP FODs
            read(bond_fods(d+1:len(trim(bond_fods))),fmt='(I4)') h             ! DN FODs
          end if
        end do
        ! 
        ! WRITE CON_MAT. Smaller atom index should always get the number of UP FODs, like (a-b)-(c-d) with a<b and c=UP, d=DN. If pattern is different -> adjust
        !
        if ((e > f) .and. (g < h)) then                                        ! e.g. (46-30)-(1-2)  -> need 1UP and 2DN between these two atoms. Assignment accordingly
          con_mat(e,f) = h
          con_mat(f,e) = g
        else if ((e > f) .and. (g > h)) then                                   ! e.g. (75-31)-(2-1)  -> need 2UP and 1DN between these two atoms. Assignment accordingly
          con_mat(e,f) = h
          con_mat(f,e) = g
        else
          con_mat(e,f) = g
          con_mat(f,e) = h
        end if
      end if
    end do
  end do
  !
  ! Construct lone FODs from bond information and nuclear charge. 
  ! Take into account all core charges 
  ! ATTENTION: This assumes charge neutrality per atom.
  !
  ! Compute core charges
  ! Get nuclear charge
  ! Get total number of bond FODs in the bond to the atom
  ! Assumption: half of these bond FODs are from this atom 
  ! Thus, if nuclear_charge - core_charge - 1/2*bond_FODs != 0  -> add number of lone FODs
  ! Number of lone FODs = (nuclear_charge - core_charge - 1/2*bond_FODs)/2. For UP and DN. If odd number, add more UP FODs
  !
  do b = 1, number_of_centers                                                   ! do for all atoms
    if (((sum(con_mat(b,:)) + sum(con_mat(:,b)))/2.0D0 + core_charge(b)) < element_number(b)) then
      lone_fods(b,1) = ceiling((element_number(b)-core_charge(b)-(sum(con_mat(b,:))+sum(con_mat(:,b)))/2.0D0)/2.0D0)            ! UP lone FODs. If uneven number of UP and DN -> give it more UP
      lone_fods(b,2) =   floor((element_number(b)-core_charge(b)-(sum(con_mat(b,:))+sum(con_mat(:,b)))/2.0D0)/2.0D0)            ! DN lone FODs. If uneven number of UP and DN -> give it more UP
    end if
  end do
  !
  ! GET THE REST OF THE LONE FODs. User input!
  ! Idea: have a pattern like 1-(1-1), meaning that atom 1 has 1 UP and 1 DN lone FOD
  ! Read lone FODs per center. 
  !
  loop8: do b = 1, number_of_centers                                            ! do for all atoms
    read(17,fmt='(A)') bla2                                                     ! read lone FOD pattern
    if (len_trim(bla2) == 0) then                                               ! if the string has 0 length -> empty space of input -> END of input
      exit loop8
    else
      loop9: do c = 1, len_trim(bla2)+1                                         ! go through the entire string
        if (bla2(c:c) == '-') then                                              ! delimiter between atomic index and lone FOD information
          read(bla2(1:c-1),fmt='(I4)') i                                        ! atomic index of the corresponding atom
        end if
        if (bla2(c:c) == '(') then                                              ! start of lone FOD information
          do d = c+1, len_trim(bla2)+1                                          ! go through the rest of the string
            if (bla2(d:d) == '-') then                                          ! delimiter between UP-lone and DN-lone FOD
              read(bla2(c+1:d-1),fmt='(I4)') lone_fods(i,1)                     ! UP lone FODs
              read(bla2(d+1:len_trim(bla2)-1),fmt='(I4)') lone_fods(i,2)        ! DN lone FODs
              exit loop9
            end if
          end do
        end if
      end do loop9
    end if
  end do loop8
  !
  ! OUTPUT ON SCREEN
  !
  write(6,*) 'Bonding information and lone FODs'
  do a = 1, number_of_centers
    c = 0
    d = 0
    write(bla2,fmt='(I4)') a
    do b = 1, number_of_centers
      if ((con_mat(a,b) /= 0) .or. (con_mat(b,a) /= 0)) then
        if (a < b) then
          c = c + con_mat(a,b)   ! spin UP in the bond
          d = d + con_mat(b,a)   ! spin DN in the bond
          write(formatBLA,fmt='(I4)')  con_mat(a,b)
          write(formatBLA2,fmt='(I4)') con_mat(b,a)
        else
          c = c + con_mat(b,a)   ! spin UP in the bond
          d = d + con_mat(a,b)   ! spin DN in the bond
          write(formatBLA,fmt='(I4)')  con_mat(b,a)
          write(formatBLA2,fmt='(I4)') con_mat(a,b)
        end if
        write(junk,fmt='(I4)') b
        write(6,*) trim(pos1_up(a)%elements),'(',trim(bla2),') - ',trim(pos1_up(b)%elements),'(',trim(junk),')     ',&
                   '       Bond pattern   ',trim(adjustl(formatBLA)),'-',trim(adjustl(formatBLA2))
      end if
    end do
    write(formatBLA,fmt='(I4)') c
    write(junk,fmt='(I4)') d
    write(6,*) trim(pos1_up(a)%elements),'(',trim(bla2),') : ',trim(adjustl(formatBLA)),' UP and ',trim(adjustl(junk)),' DN - Bond'
    write(formatBLA,fmt='(I4)') lone_fods(a,1)
    write(junk,fmt='(I4)') lone_fods(a,2)
    write(6,*) trim(pos1_up(a)%elements),'(',trim(bla2),') : ',trim(adjustl(formatBLA)),' UP and ',trim(adjustl(junk)),' DN - lone' 
    write(6,*) ' '
  end do
  !
  ! END OUTPUT
  !
  ! Longest bond distance between all bonded atoms
  ! Use this to determine the distance of all double/triple
  ! bonds and lone FODs
  ! Here, initialization
  d_bond = 0.0D0
  !
  !
  !
  do a = 1, number_of_centers
    !
    ! Get number of valence FODs from con_mat and lone_fods 
    ! UP CHANNEL
    pos1_up(a)%n_points(pos1_up(a)%n_shells) = 0                               ! Initialize new number of valence UP
    do b = 1, number_of_centers
      if (a < b) then
        pos1_up(a)%n_points(pos1_up(a)%n_shells) = pos1_up(a)%n_points(pos1_up(a)%n_shells) + con_mat(a,b)
      else
        continue
      end if
    end do
    pos1_up(a)%n_points(pos1_up(a)%n_shells) = pos1_up(a)%n_points(pos1_up(a)%n_shells) + lone_fods(a,1)
    pos2_up(a)%n_points(pos1_up(a)%n_shells) = pos1_up(a)%n_points(pos1_up(a)%n_shells)

    ! DN CHANNEL
    pos1_dn(a)%n_points(pos1_dn(a)%n_shells) = 0                               ! Initialize new number of valence DN
    do b = 1, number_of_centers
      if (a > b) then
        pos1_dn(a)%n_points(pos1_dn(a)%n_shells) = pos1_dn(a)%n_points(pos1_dn(a)%n_shells) + con_mat(a,b)
      else
        continue
      end if
    end do
    pos1_dn(a)%n_points(pos1_dn(a)%n_shells) = pos1_dn(a)%n_points(pos1_dn(a)%n_shells) + lone_fods(a,2)
    pos2_dn(a)%n_points(pos1_dn(a)%n_shells) = pos1_dn(a)%n_points(pos1_dn(a)%n_shells)
    !
    ! Temporary array to store number of shells and radii for all shells. 
    ! 10 ... there is no element with that many shells. So this is just a temporary number.
    ! Use these radii later on
    !
    allocate(r_tmp_up(10))
    allocate(r_tmp_dn(10))
    allocate(N_tmp_up(10))
    allocate(N_tmp_dn(10))
    r_tmp_up(:) = 0.0D0
    r_tmp_dn(:) = 0.0D0
    N_tmp_up(:) = 0.0D0
    N_tmp_dn(:) = 0.0D0

    call database(pos1_up(a)%elements,element_number(a),pseudo_charge(a), &  ! get all initial data
                  core_charge(a), covalent_R(a), &
                  pos1_up(a)%n_shells, pos1_dn(a)%n_shells, &
                  N_tmp_up,N_tmp_dn,r_tmp_up,r_tmp_dn)

    !
    ! allocate radii, theta, phi and xyz for the FODs
    !
    allocate(pos1_up(a)%r_theta_phi(pos1_up(a)%n_shells,sum(pos1_up(a)%n_points(:)),3))
    allocate(pos2_up(a)%r_theta_phi(pos2_up(a)%n_shells,sum(pos2_up(a)%n_points(:)),3))
    allocate(pos1_dn(a)%r_theta_phi(pos1_dn(a)%n_shells,sum(pos1_dn(a)%n_points(:)),3))
    allocate(pos2_dn(a)%r_theta_phi(pos2_dn(a)%n_shells,sum(pos2_dn(a)%n_points(:)),3))
    allocate(pos1_up(a)%point_x_y_z(pos1_up(a)%n_shells,sum(pos1_up(a)%n_points(:)),3))
    allocate(pos2_up(a)%point_x_y_z(pos2_up(a)%n_shells,sum(pos2_up(a)%n_points(:)),3))
    allocate(pos1_dn(a)%point_x_y_z(pos1_dn(a)%n_shells,sum(pos1_dn(a)%n_points(:)),3))
    allocate(pos2_dn(a)%point_x_y_z(pos2_dn(a)%n_shells,sum(pos2_dn(a)%n_points(:)),3))
    !
    ! store the radii of for the different shells 
    ! INITIALIZE THE POINTS ! Here for core FODs 
    do b = 1, pos1_up(a)%n_shells-1
      pos1_up(a)%r_theta_phi(b,1,1) = r_tmp_up(b)*units_factor   ! convert the radius to the correct units
      do c = 1, pos1_up(a)%n_points(b)                                             ! store all other values for this shell accordingly. Add theta and phi.
        pos1_up(a)%r_theta_phi(b,c,1:3) = (/ pos1_up(a)%r_theta_phi(b,1,1), real(pi/2.0,8), real(0.0,8) /)
        pos2_up(a)%r_theta_phi(b,c,1:3) = pos1_up(a)%r_theta_phi(b,c,1:3)
        pos1_up(a)%point_x_y_z(b,c,1:3) = (/ pos1_up(a)%r_theta_phi(b,1,1) + pos1_up(a)%center_x_y_z(1), &
                                           & pos1_up(a)%center_x_y_z(2),     pos1_up(a)%center_x_y_z(3) /)
        pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
      end do
    end do
    do b = 1, pos1_dn(a)%n_shells-1
      pos1_dn(a)%r_theta_phi(b,1,1) = r_tmp_dn(b)*units_factor   ! convert the radius to the correct units
      do c = 1, pos1_dn(a)%n_points(b)                                             ! store all other values for this shell accordingly. Add theta and phi.
        pos1_dn(a)%r_theta_phi(b,c,1:3) = (/ pos1_dn(a)%r_theta_phi(b,1,1), real(pi/2.0,8), real(0.0,8) /)
        pos2_dn(a)%r_theta_phi(b,c,1:3) = pos1_dn(a)%r_theta_phi(b,c,1:3)
        pos1_dn(a)%point_x_y_z(b,c,1:3) = (/ pos1_dn(a)%r_theta_phi(b,1,1) + pos1_dn(a)%center_x_y_z(1), &
                                           & pos1_dn(a)%center_x_y_z(2),     pos1_dn(a)%center_x_y_z(3) /)
        pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
      end do
    end do
    ! 
    ! get valence FOD radii. Here for non-bonded atoms. Use radii from database (r_tmp)
    !
    if (sum(con_mat(a,:)) == 0) then                                           ! No bonds
      ! UP Channel
      b = pos1_up(a)%n_shells                                              ! store the different radii and number of points in arrays. ONLY VALENCE
      pos1_up(a)%r_theta_phi(b,1,1) = r_tmp_up(b)*units_factor   ! convert the radius to the correct units
      do c = 1, pos1_up(a)%n_points(b)                                             ! initialize all lone_fods as specified in the system file.  pos1_up(a)%n_points(b) = lone_fods(a,1)
        pos1_up(a)%r_theta_phi(b,c,1:3) = (/ pos1_up(a)%r_theta_phi(b,1,1), real(pi/2.0,8), real(0.0,8) /)
        pos2_up(a)%r_theta_phi(b,c,1:3) = pos1_up(a)%r_theta_phi(b,c,1:3)
        pos1_up(a)%point_x_y_z(b,c,1:3) = (/ pos1_up(a)%r_theta_phi(b,1,1) + pos1_up(a)%center_x_y_z(1), &
                                           & pos1_up(a)%center_x_y_z(2),     pos1_up(a)%center_x_y_z(3) /)
        pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
      end do
      ! DN Channel
      b = pos1_dn(a)%n_shells                                              ! store the different radii and number of points in arrays
      pos1_dn(a)%r_theta_phi(b,1,1) = r_tmp_dn(b)*units_factor   ! convert the radius to the correct units
      do c = 1, pos1_dn(a)%n_points(b)                                             ! initialize all lone_fods as specified in the system file.  pos1_dn(a)%n_points(b) = lone_fods(a,2)
        pos1_dn(a)%r_theta_phi(b,c,1:3) = (/ pos1_dn(a)%r_theta_phi(b,1,1), real(pi/2.0,8), real(0.0,8) /)
        pos2_dn(a)%r_theta_phi(b,c,1:3) = pos1_dn(a)%r_theta_phi(b,c,1:3)
        pos1_dn(a)%point_x_y_z(b,c,1:3) = (/ pos1_dn(a)%r_theta_phi(b,1,1) + pos1_dn(a)%center_x_y_z(1), &
                                           & pos1_dn(a)%center_x_y_z(2),     pos1_dn(a)%center_x_y_z(3) /)
        pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
      end do
    !
    ! For bonded atoms: get valence FOD radii from molecular geometry. Evaluate distances to adjacent atoms
    ! use distance between atoms as radii. Only relevant for lone FODs
    ! TODO
    ! 
    ! KT: HERE adjust radius determination. Make sure that, e.g., all C atoms have the same radius. 
    !     use largest distance to all adjacent atoms
    !
    ! do b = 1, number_of_centers
    !     if con_mat(a,b) .neq. 0 then
    !         check distance, and take whatever is smallest/largest
    else
      do b = 1, number_of_centers
        ! For bonded atoms
        if (con_mat(a,b) /= 0 .or. con_mat(b,a) /= 0) then
          ave_dist1 = sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:))**2))         ! take shortest distance to neighboring atoms -> use 1/2 of this as radius
          if (periodic) then                                                                          ! In a peridoic system, take cell vectors into account
            do c = 1, 3
              do d = 1, 3
                do e = 1, 3
                  if (sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                               (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:))**2)) < ave_dist1) then
                    ave_dist1 = sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                                         (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:))**2))
                  end if
                end do
              end do
            end do
          end if

          if (ave_dist1 > d_bond) then
            d_bond = ave_dist1
          end if
        end if
      end do
    end if
    ! Deallocate temporary arrays
    deallocate(r_tmp_up)
    deallocate(r_tmp_dn)
    deallocate(N_tmp_up)
    deallocate(N_tmp_dn)
  end do

  ! KT: HERE
  ! Do this only for bonded atoms??

  ! INITIALIZE THE POINTS ! 
  ! d_bond was determined beforehand
  do a = 1, number_of_centers
    ! INITIALIZE THE POINTS ! Here for valence UP-FODs
    b = pos1_up(a)%n_shells
    do c = 1, pos1_up(a)%n_points(b)
      pos1_up(a)%r_theta_phi(b,c,1:3) = (/ d_bond/2.0D0, real(pi/2.0,8), real(0.0,8) /)
      pos2_up(a)%r_theta_phi(b,c,1:3) = pos1_up(a)%r_theta_phi(b,c,1:3)
      pos1_up(a)%point_x_y_z(b,c,1:3) = (/ d_bond/2.0D0 + pos1_up(a)%center_x_y_z(1), &
                                         & pos1_up(a)%center_x_y_z(2), pos1_up(a)%center_x_y_z(3) /)
      pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
    end do
    ! INITIALIZE THE POINTS ! Here for valence DN-FODs
    b = pos1_dn(a)%n_shells
    do c = 1, pos1_dn(a)%n_points(b)
      pos1_dn(a)%r_theta_phi(b,c,1:3) = (/ d_bond/2.0D0, real(pi/2.0,8), real(0.0,8) /)
      pos2_dn(a)%r_theta_phi(b,c,1:3) = pos1_dn(a)%r_theta_phi(b,c,1:3)
      pos1_dn(a)%point_x_y_z(b,c,1:3) = (/ d_bond/2.0D0 + pos1_dn(a)%center_x_y_z(1), &
                                         & pos1_dn(a)%center_x_y_z(2), pos1_dn(a)%center_x_y_z(3) /)
      pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
    end do
  end do

  !
  ! Put all 1s core FODs (index (1,1,1:3)) at the origin
  ! If NOT pseudopotential
  !
  do a = 1, number_of_centers 
    if ((fix1s).and.(pos1_up(a)%elements(3:5).ne.'ECP').and.(pos1_up(a)%elements(4:6).ne.'ECP')) then
      pos1_up(a)%r_theta_phi(1,1,1:3) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
      pos1_up(a)%point_x_y_z(1,1,1:3) = pos1_up(a)%center_x_y_z(1:3)
      pos2_up(a)%r_theta_phi(1,1,1:3) = pos1_up(a)%r_theta_phi(1,1,1:3)
      pos2_up(a)%point_x_y_z(1,1,1:3) = pos1_up(a)%point_x_y_z(1,1,1:3)
      pos1_dn(a)%r_theta_phi(1,1,1:3) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
      pos1_dn(a)%point_x_y_z(1,1,1:3) = pos1_dn(a)%center_x_y_z(1:3)
      pos2_dn(a)%r_theta_phi(1,1,1:3) = pos1_dn(a)%r_theta_phi(1,1,1:3)
      pos2_dn(a)%point_x_y_z(1,1,1:3) = pos1_dn(a)%point_x_y_z(1,1,1:3)
    end if
  end do
! End if: whether there is only one atom, or more
end if

!!!!!!!!!!!!!!!!!!!
! Initialization. !
!!!!!!!!!!!!!!!!!!!
call cpu_time(start_t)
!
! DEFINE NUMBER OF MC CYCLES ACCORDING TO THE NUMBER OF ELECTRONS. MINIMUM IS 5000, MAXIMUM IS 50000
!
cycles = 0
do b = 1, size(pos1_up)
  cycles = cycles + sum(pos1_up(b)%n_points(:))*1000
  cycles = cycles + sum(pos1_dn(b)%n_points(:))*1000
end do
if (cycles < 5000) then
  cycles = 5000
else if (cycles > 50000) then
  cycles = 50000
end if
! DEFINE STEP SIZE
step_size = 0.001D0
! DEFINE SCALING FACTOR FOR MULTIPLE BONDS/LONE FODS
scale_r = 0.65D0

!!!write(6,*) ' '
!!!!write(6,fmt='(A,I7,2X,A,2X,F7.4,2X,A,2X,F7.4)') 'Cycles:',cycles,' Step_size:',step_size,' Scale factor: ',scale_r
!!!write(6,666) 'Cycles:',cycles,' Step_size:',step_size,' Scale factor: ',scale_r
!!!666 FORMAT (A9,I7,2X,A,2X,F7.4,2X,A,2X,F7.4)

close(unit=17) ! close 'system'
close(unit=18) ! close 'xx_database_xx'

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! If only one center is present -> Atomic guess creation !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if (number_of_centers == 1) then
!
! If distribution of points on a sphere is wanted -> change number of MC steps and step size
!
  if (pos1_up(1)%elements == 'POS') then
    write(6,*) ' '
    write(6,*) '!!! POINTS ON A SPHERE WITH ', sum(pos1_up(1)%n_points(:)), ' UP and ',sum(pos1_dn(1)%n_points(:)),' DN'
    write(6,*) ' '
    write(6,*) 'How many Monte-Carlo steps?'
    read(5,*) cycles
    write(6,*) 'What step-size?'
    read(5,*) step_size
!
! ELSE: For an atomic guess generation
!
  else
    a = 1
    charge = 0.0
    spin = 0.0

    charge     = real(element_number(1) - pseudo_charge(1) - &
               & sum(pos1_up(1)%n_points(:)) - sum(pos1_dn(1)%n_points(:)),8)
    spin       = real(sum(pos1_up(1)%n_points(:)) - sum(pos1_dn(1)%n_points(:)),8)

    write(6,*) ' '
    write(6,*) '!!! ATOMIC GUESS WILL BE CREATED FOR  ', pos1_up(1)%elements, '  charge = ',charge,' spin = ',spin
    write(6,*) ' '
  end if

!!!!!!!!!!!!!!!!!!!!!
! CORE OPTIMIZATION !
!!!!!!!!!!!!!!!!!!!!!
! IDEA: Use structural motifs instead of individual optimization. Rotate these via MC (USE METROPOLIS!)
! NEW  struct_motif(n_point_tot,n_point,radius,position_point)
  !
  ! Get UP CHANNEL  
  !
  do b = 1, pos1_up(a)%n_shells                                              ! All shells !
    do c = 1, pos1_up(a)%n_points(b)
      call struct_motif(pos1_up(a)%n_points(b),c,pos1_up(a)%r_theta_phi(b,c,1),&
                        pos1_up(a)%center_x_y_z(1:3),pos1_up(a)%point_x_y_z(b,c,1:3))
      !
      ! invert motif if b is an even number
      ! KT: TODO inversion needs to be with respect to atomic position!!!
      !
      !!!if (mod(b,2) == 0) then
      !!!  pos1_up(a)%point_x_y_z(b,c,1:3) = -1.0D0*pos1_up(a)%point_x_y_z(b,c,1:3)
      !!!end if

      pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
    end do
    !
    ! Optimize core structure globally (via rotations) with respect to any smaller shell
    !
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! ROTATIONS                                              !
    ! Rotate current core against any lower core. UP Channel !
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    if ((b > 1) .and. (b <= pos1_up(a)%n_shells)) then                             ! any shell except the 1s. 
      ave_dist1_up = 100000000.0
      do t = 1, cycles
        call create_rotMat(full_rot, step_size)                                    ! generates a random rotation matrix
        do c = 1, pos1_up(a)%n_points(b)
          call rotate_pos(full_rot, pos1_up(a)%point_x_y_z(b,c,1:3), &
                          pos1_up(a)%center_x_y_z(1:3), pos2_up(a)%point_x_y_z(b,c,1:3))
        end do
        !
        ! 1/r calculation
        !
        ave_dist2_up = 0.0                                                         ! 1/r UP
        do c = 1, pos2_up(a)%n_points(b)
          do d = 1, b-1                                                            ! Use any smaller shell structure and optimize the higher shell according to the lower core structure
            do f = 1, pos1_up(a)%n_points(d)                                       ! Unchanged index, thus index 1
              ave_dist2_up  = ave_dist2_up + &
                     1.0D0/sqrt(sum((pos2_up(a)%point_x_y_z(b,c,:) - pos1_up(a)%point_x_y_z(d,f,:))**2))
            end do
          end do
        end do
        if (ave_dist2_up < ave_dist1_up) then
          pos1_up(a)%point_x_y_z(:,:,:) = pos2_up(a)%point_x_y_z(:,:,:)
          pos1_up(a)%r_theta_phi(:,:,:) = pos2_up(a)%r_theta_phi(:,:,:)
          ave_dist1_up = ave_dist2_up
        end if
      end do  ! end MC cycles
    end if    ! end if - shells
  end do      ! end UP channel
  !
  ! Get DN CHANNEL  
  !
  do b = 1, pos1_dn(a)%n_shells                                              ! All shells !
    do c = 1, pos1_dn(a)%n_points(b)
      call struct_motif(pos1_dn(a)%n_points(b),c,pos1_dn(a)%r_theta_phi(b,c,1),&
                        pos1_dn(a)%center_x_y_z(1:3),pos1_dn(a)%point_x_y_z(b,c,1:3))
      !
      ! invert motif if b is an odd number
      ! KT: TODO inversion needs to be wrt atomic position
      !
      !!if (mod(b,2) == 1) then
      !!  pos1_dn(a)%point_x_y_z(b,c,1:3) = -1.0D0*pos1_dn(a)%point_x_y_z(b,c,1:3)
      !!end if
      pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
    end do
    !
    ! Optimize core structure globally (via rotations) with respect to any smaller shell
    !
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! ROTATIONS                                              !
    ! Rotate current core against any lower core. DN Channel !
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    if ((b > 1) .and. (b <= pos1_dn(a)%n_shells)) then                             ! any shell except the 1s. 
      ave_dist1_dn = 100000000.0
      do t = 1, cycles
        call create_rotMat(full_rot, step_size)                                    ! generates a random rotation matrix
        do c = 1, pos1_dn(a)%n_points(b)
          call rotate_pos(full_rot, pos1_dn(a)%point_x_y_z(b,c,1:3), &
                          pos1_dn(a)%center_x_y_z(1:3), pos2_dn(a)%point_x_y_z(b,c,1:3))
        end do
        !
        ! 1/r calculation
        !
        ave_dist2_dn = 0.0                                                         ! 1/r DN
        do c = 1, pos2_dn(a)%n_points(b)
          do d = 1, b-1                                                            ! Use any smaller shell structure and optimize the higher shell according to the lower core structure
            do f = 1, pos1_dn(a)%n_points(d)                                       ! Unchanged index, thus index 1
              ave_dist2_dn  = ave_dist2_dn + &
                     1.0D0/sqrt(sum((pos2_dn(a)%point_x_y_z(b,c,:) - pos1_dn(a)%point_x_y_z(d,f,:))**2))
            end do
          end do
        end do
        if (ave_dist2_dn < ave_dist1_dn) then
          pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
          pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
          ave_dist1_dn = ave_dist2_dn
        end if
      end do  ! end MC cycles
      !
      ! After optimizing the core structure of the DN channel -> optimize it via rotations with respect to the UP channel (only lower core structure as well, and same level in addition)
      ! Rotate all core structure below the current one AND the current one as well
      ! 
      ave_dist1 = 100000000.0
      do t = 1, cycles
        call create_rotMat(full_rot, step_size)                                    ! generates a random rotation matrix
        do d = 1, b                                                                ! all shell up to the current core level
          do c = 1, pos1_dn(a)%n_points(d)                                           ! rotate all dn points up to the current core level (keep symmetry between the lower core structures the same)
            call rotate_pos(full_rot, pos1_dn(a)%point_x_y_z(d,c,1:3), &
                            pos1_dn(a)%center_x_y_z(1:3), pos2_dn(a)%point_x_y_z(d,c,1:3))
          end do
        end do
    ! 1/r calculation
        ave_dist2 = 0.0                                                           ! 1/r between dn and up !!!
        do d = 1, b
          do c = 1, pos2_dn(a)%n_points(d)
            do e = 1, min(b,pos1_up(a)%n_shells)                                   ! This loop for the UP channel goes only to the current core level. If the current core level doesn't exist -> use the maximum available
              do f = 1, pos1_up(a)%n_points(e)
                if (pos2_dn(a)%elements(3:5) == 'ECP' .or. pos2_dn(a)%elements(4:6) == 'ECP') then   ! if ECP are used -> there is no core. Just evaluate the 1/r
                  ave_dist2 = ave_dist2 + &
                        1.0D0/sqrt(sum((pos2_dn(a)%point_x_y_z(d,c,:) - pos1_up(a)%point_x_y_z(e,f,:))**2))
                else
                  if ((d == 1) .and. (e == 1)) then                                ! avoid evaluating 1s UP and 1s DN (largest contribution) -> makes optimization extremely inefficient !!
                  else
                    ave_dist2  = ave_dist2 + &
                           1.0D0/sqrt(sum((pos2_dn(a)%point_x_y_z(d,c,:) - pos1_up(a)%point_x_y_z(e,f,:))**2))
                  end if
                end if
              end do
            end do
          end do
        end do
        ! Keep config ?
        if (ave_dist2 < ave_dist1) then
          pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
          pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
          ave_dist1 = ave_dist2
        end if
      end do  ! end MC cycles
    end if    ! end if - shells
  end do      ! end UP channel
! END NEW

! INCLUDE POS AT SOME POINT. CURRENTLY MISSING


  call cpu_time(finish_t)
  write(6,*) 'up-dn global   ', ave_dist1
  write(6,*) 'Total CPU time ',finish_t - start_t,'s'

!
! If distribution of points on a sphere
!
  if (pos1_up(1)%elements == 'POS') then
    open(unit=19,file='points_on_sphere.xyz',status='unknown',action='write')
    write (junk, '(I8)') size(pos1_up)+sum(pos1_up(1)%n_points(:))+sum(pos1_dn(1)%n_points(:))-1                     ! number of entries in the xyz file. Exclude 'atom'
    write(19,fmt='(A)') adjustl(junk)
    write(19,*) 'points on a sphere'
    d = 1
    do b = 1, pos1_up(d)%n_shells
      do c = 1, pos1_up(d)%n_points(b)
        write(19,fmt='(A3,4X,3(F13.8,2X))') 'X',pos1_up(d)%point_x_y_z(b,c,1:3)*0.529177D0/units_factor
      end do
    end do
    do b = 1, pos1_dn(d)%n_shells
      do c = 1, pos1_dn(d)%n_points(b)
        write(19,fmt='(A4,3X,3(F13.8,2X))') 'He',pos1_dn(d)%point_x_y_z(b,c,1:3)*0.529177D0/units_factor
      end do
    end do
    close(unit=19)

!
! For atomic guess generation
!
  else 
!
! GENERATE CLUSTER AND FRMORB FILE for NRLMOL
!
    if (output_mode == 'NRLMOL') then
      charge = real(element_number(1) - pseudo_charge(1) - sum(pos1_up(1)%n_points(:)) - sum(pos1_dn(1)%n_points(:)),8)
      spin   = real(sum(pos1_up(1)%n_points(:)) - sum(pos1_dn(1)%n_points(:)),8)
      open(unit=19,file='CLUSTER',status='unknown',action='write')
      write(19,fmt='(A)') 'LDA-PW91*LDA-PW91            (DF TYPE EXCHANGE*CORRELATION)'
      write(19,fmt='(A)') 'NONE                         (TD, OH, IH, X, Y, XY, ... OR GRP)'
      write(19,fmt='(A)') '1                            (NUMBER OF ATOMS)'
      if ((pos1_up(1)%elements(3:5) == 'ECP') .or. (pos1_up(1)%elements(4:6) == 'ECP')) then
        write(19,fmt='(3(F13.8,2X),I3,1X,A)') pos1_up(1)%center_x_y_z(1:3)/units_factor, element_number(1), & 
                     & '  ECP (R, Z, Pseudopotential)'
      else
        write(19,fmt='(3(F13.8,2X),I3,1X,A)') pos1_up(1)%center_x_y_z(1:3)/units_factor, element_number(1), &
                     & '  ALL (R, Z, ALL-ELECTRON)'
      end if
      write(19,fmt='(2(F6.3,2X),19X,A)') charge, spin, '(NET CHARGE AND NET SPIN)'
      close(unit=19)

      open(unit=19,file='FRMORB',status='unknown',action='write')
      write(19,fmt='(I3,5X,I3)') sum(pos1_up(1)%n_points(:)), sum(pos1_dn(1)%n_points(:))
      d = 1
      do b = 1, pos1_up(d)%n_shells
        do c = 1, pos1_up(d)%n_points(b)
          write(19,fmt='(3(F13.8,2X))') pos1_up(d)%point_x_y_z(b,c,1:3)/units_factor
        end do
      end do
      do b = 1, pos1_dn(d)%n_shells
        do c = 1, pos1_dn(d)%n_points(b)
          write(19,fmt='(3(F13.8,2X))') pos1_dn(d)%point_x_y_z(b,c,1:3)/units_factor
        end do
      end do
      close(unit=19)
!
! GENERATE Nuc_FOD.xyz. For PyFLOSIC
!
    else if (output_mode == 'PyFLOSIC') then
      open(unit=19,file=output_name,status='unknown',action='write')
      write (junk, '(I8)') size(pos1_up)+sum(pos1_up(1)%n_points(:))+sum(pos1_dn(1)%n_points(:))                       ! number of entries in the xyz file
      write(19,fmt='(A)') adjustl(junk)
      write(19,*) "sym_fod1='X' sym_fod2='He'"
      if (pos1_up(1)%elements(2:2)=='_'.or.pos1_up(1)%elements(2:2)=='') then
        write(19,fmt='(A4,3X,3(F13.8,2X))') pos1_up(1)%elements(1:1),pos1_up(1)%center_x_y_z(1:3)*0.529177D0/units_factor ! always in angstrom
      else
        write(19,fmt='(A4,3X,3(F13.8,2X))') pos1_up(1)%elements(1:2),pos1_up(1)%center_x_y_z(1:3)*0.529177D0/units_factor
      end if
      d = 1
      do b = 1, pos1_up(d)%n_shells
        do c = 1, pos1_up(d)%n_points(b)
          write(19,fmt='(A4,3X,3(F13.8,2X))') 'X',pos1_up(d)%point_x_y_z(b,c,1:3)*0.529177D0/units_factor
        end do
      end do
      do b = 1, pos1_dn(d)%n_shells
        do c = 1, pos1_dn(d)%n_points(b)
          write(19,fmt='(A4,3X,3(F13.8,2X))') 'He',pos1_dn(d)%point_x_y_z(b,c,1:3)*0.529177D0/units_factor
        end do
      end do
      close(unit=19)

    else
      write(6,*) 'output_mode not recognized. Valid values are NRLMOL and PyFLOSIC'
    end if

  end if




































!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! More than one center is present -> Molecular guess creation !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !
  ! Step-wise procedure:  1. get bonds
  !                       2. get lone pairs
  !                       3. optimize the core accordingly
  !
else                                                                           ! more than one atom -> molecular/periodic guess creation
  !
  ! WRITING STUFF TO SCREEN
  !
  allocate(element_symbol(number_of_centers))                                  ! maximum number of element symbols
  do a = 1, number_of_centers
    element_symbol(a) = 'Y'                                                    ! dummy argument
  end do
  counter = 0
  do a = 1, size(pos1_up)
    c = 0
    do b = 1, number_of_centers                                                ! if element already in the list -> ignore
      if ((pos1_up(a)%elements(1:1) == element_symbol(b) .and. (pos1_up(a)%elements(2:2) == ' ')) &   ! avoid confusion betweenn e.g. Na and N
     .or. (pos1_up(a)%elements(1:2) == element_symbol(b))) then
        c = c + 1
      end if
    end do
    if (c == 0) then
      counter = counter + 1
      if ((pos1_up(a)%elements(2:2) == '_') .or. (pos1_up(a)%elements(2:2) == ' ')) then
        element_symbol(counter) = pos1_up(a)%elements(1:1)
      else if ((pos1_up(a)%elements(3:3) == '_') .or. (pos1_up(a)%elements(3:3) == ' ')) then
        element_symbol(counter) = pos1_up(a)%elements(1:2)
      end if
    end if
  end do
  allocate(element_count(counter))
  do a = 1, counter
    d = 0
    do b = 1, number_of_centers
      if (((pos1_up(b)%elements(1:1) == element_symbol(a)) .and. &
        & ((pos1_up(b)%elements(2:2) == ' ') .or. (pos1_up(b)%elements(2:2) == '_'))) .or. &       ! Element with a single symbol (like N)
        &  (pos1_up(b)%elements(1:2) == element_symbol(a))) then                                   ! Element with more than one symbol (like Ni)
        d = d + 1
      end if
    end do
    if (d == 1) then
      element_count(a) = ' '
    else
      write(element_count(a),fmt='(I4)') d
    end if
  end do

  charge     = 0.0
  spin       = 0.0
  do a = 1, size(pos1_up)
    charge     = charge + real(element_number(a) - pseudo_charge(a) - &
               & sum(pos1_up(a)%n_points(:)) - sum(pos1_dn(a)%n_points(:)),8)
    spin       = spin   + real(sum(pos1_up(a)%n_points(:)) - sum(pos1_dn(a)%n_points(:)),8)
  end do

  write(6,*) ' '
  if (periodic) then
    write(6,*) '!!! PERIODIC GUESS WILL BE CREATED FOR    ', &
                  & (trim(element_symbol(a)),trim(adjustl(element_count(a))),a=1,counter)
  else
    write(6,*) '!!! MOLECULAR GUESS WILL BE CREATED FOR     ', &
                  & (trim(element_symbol(a)),trim(adjustl(element_count(a))),a=1,counter)
  end if
  write(6,*) ' '
  deallocate(element_symbol)
  deallocate(element_count)
  !
  ! END WRITING STUFF TO SCREEN
  !



!
! Check whether atoms are in a planar or linear environment. Needed later for bonds and lone FODs
!
  allocate(is_planar_linear(size(pos1_up)))
  is_planar_linear(:) = 0                                                       ! initialize all to be 0 (neither planar nor linear)
  if (size(pos1_up) > 2) then                                                   ! ignore diatomics
    !
    ! Go through all atoms
    !
    do a = 1, size(pos1_up)
      counter = 0
      do b = 1, size(pos1_up)
        if (con_mat(a,b) /= 0) then
          !
          ! count the number of bond partners
          !
          counter = counter + 1
        end if
      end do

      !
      ! If only one bond partner -> linear 
      !   no good right now: Transforms lone FODs instead of bond FODs for CO2
      !!if (counter == 1) then
      !!  is_planar_linear(a) = 2
      !!end if


      !
      ! When an atom has exactly two bonds -> check whether it is in a linear environment or not -> dot product of the bond vectors needs to be -1 or 1 (angle either 0 or 180)
      ! If not -> planar
      !
      if (counter == 2) then
        counter = 0
        allocate(tmp_vectors(2,3))
        do b = 1, size(pos1_up)
          if (con_mat(a,b) /= 0) then
            counter = counter + 1
            tmp_vectors(counter,:) = (pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:))
            if (periodic) then                                                  ! In a peridoic system, take cell vectors into account
              do d = 1, 3
                do e = 1, 3
                  do f = 1, 3
                    if (sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                                 (d-2)*cell_a(:) + (e-2)*cell_b(:) + (f-2)*cell_c(:))**2)) < &
                                 (sqrt(sum(tmp_vectors(counter,:)**2)))) then
                      tmp_vectors(counter,:) = pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                                               (d-2)*cell_a(:) + (e-2)*cell_b(:) + (f-2)*cell_c(:)
                    end if
                  end do
                end do
              end do
            end if 
          end if
        end do
        t = 0
        do c = 1, counter-1
          do d = c+1, counter
            if (abs(dot_product(tmp_vectors(c,:),tmp_vectors(d,:)/&
               (sqrt(sum(tmp_vectors(c,:)**2))*sqrt(sum(tmp_vectors(d,:)**2))))) > 0.98) then
              t = t + 1
            end if
          end do
        end do
        if (t == (counter*(counter-1))/2) then
          is_planar_linear(a) = 2
        else
          is_planar_linear(a) = 1
        end if
        deallocate(tmp_vectors)
      end if

      !
      ! For more bonds
      !
      if (counter > 2) then
        allocate(tmp_vectors(counter+(counter*(counter-1)/2),3))                ! store bond vectors (counter) and perpendicular vectors (counter*(counter-1)/2)
        c = 0                                                                   ! counter for the determination of how many bond vectors are needed
        t = 0                                                                   ! checking counter. If it always increased for all pairs of bonds -> do something
        do b = 1, size(pos1_up)
          !
          ! store all bond vectors
          !
          if (con_mat(a,b) /= 0) then
            c = c + 1  
            tmp_vectors(c,:) = (pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:))
            if (periodic) then                                                  ! In a peridoic system, take cell vectors into account
              do d = 1, 3
                do e = 1, 3
                  do f = 1, 3
                    if (sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                                 (d-2)*cell_a(:) + (e-2)*cell_b(:) + (f-2)*cell_c(:))**2)) < &
                                 (sqrt(sum(tmp_vectors(c,:)**2)))) then
                      tmp_vectors(c,:) = pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                                         (d-2)*cell_a(:) + (e-2)*cell_b(:) + (f-2)*cell_c(:)
                    end if
                  end do
                end do
              end do
            end if
          end if
        end do
        ! Cross product for each pair of bond vectors -> perpendicular vectors
        ! Need the angles between these perpendicular vectors 
        ! if they all are aligned/counteralinged (angle = 0 or 180 degree) -> planar !
        do b = 1, size(pos1_up)
          if (con_mat(a,b) /= 0) then
            f = 0                                                               ! variable to store the perpendicular vectors
            do c = 1, counter-1
              do d = c+1, counter
                f = f + 1 
                !
                ! cross product
                !
                tmp_vectors(counter+f,1) = tmp_vectors(c,2)*tmp_vectors(d,3) - tmp_vectors(c,3)*tmp_vectors(d,2)
                tmp_vectors(counter+f,2) = tmp_vectors(c,3)*tmp_vectors(d,1) - tmp_vectors(c,1)*tmp_vectors(d,3)
                tmp_vectors(counter+f,3) = tmp_vectors(c,1)*tmp_vectors(d,2) - tmp_vectors(c,2)*tmp_vectors(d,1)
              end do
            end do
          end if 
        end do
        ! 
        ! get dot product. If the perpendicular vectors are aligned -> their angle is either 0 or 180 -> their cosine is either -1 or 1 -> abs(DOT) must be close to 1 
        ! cos alpha = dot/(len_a*len_b)
        !
        do c = 1, counter-1
          do d = c+1, counter
            if (abs(dot_product(tmp_vectors(c+f,:),tmp_vectors(d+f,:)/&
               (sqrt(sum(tmp_vectors(c+f,:)**2))*sqrt(sum(tmp_vectors(d+f,:)**2))))) > 0.98) then
              t = t + 1
            end if
          end do 
        end do
        !
        ! check whether all bonds are in plane
        !
        if (t == (counter*(counter-1))/2) then
          is_planar_linear(a) = 1
        end if
        !
        ! deallocate for next atom
        !
        deallocate(tmp_vectors)
      end if     
    end do
  end if
!
! DONE planarity/linearity check
!

!
! Find centers between atoms. Place as many FODs around these as defined in con_mat. 
! Single bond:  Place 1 UP and 1 DN FOD at center (for X-H, place closer to H (instead of 0.5*bond length, use 0.85*bond length))
! Double bonds: Place 2 UP and 2 DN FODs perpendicular to the bond axis (using optimization routines based on MC)
! Triple bonds: Place 3 UP and 3 DN FODs in a triangle around the bond axis (using optimization routines based on MC)
! Quadruple bonds: 4 UP and 4 DN in a square
! ...
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!! 1. get bonds !!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  do a = 1, size(pos1_up)                                                      ! for each atom
    if (sum(con_mat(a,:)) == 0) then                                           ! In case there are no bonds to that atoms -> skip this section
      continue
    else
      do b = 1, size(pos1_up)                                                  ! for each other atom.
        if (con_mat(a,b) /= 0) then                                            ! for atoms which are bonded
          !
          ! get bond center and vector describing the bond
          !
          bond_center(:) = (pos1_up(a)%center_x_y_z(:) + pos1_up(b)%center_x_y_z(:))/2.0D0
          bond_vector(:) =  pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) ! vector from b to a          
          if (periodic) then                                                        ! In a peridoic system, take cell vectors into account
            do c = 1, 3
              do d = 1, 3
                do e = 1, 3
                  if (sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                               (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:))**2)) < &
                               (sqrt(sum(bond_vector(:)**2)))) then
                    bond_center(:) = (pos1_up(a)%center_x_y_z(:) + pos1_up(b)%center_x_y_z(:) + &
                                     (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:))/2.0D0
                    bond_vector(:) = pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                                     (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:)
                  end if
                end do
              end do
            end do
          end if
          !
          ! find a vector which is perpendicular to the bond vector
          !
          call per_vector(bond_vector(:),pos1_up(a)%center_x_y_z(:),perpendicular_vec(:))

          !!!!!!!!!!!!!!!!!!!!
          ! SINGLE BOND FODs !
          !!!!!!!!!!!!!!!!!!!!
          if (con_mat(a,b) == 1) then
            if (a < b) then                                                    ! Add UP FOD
              c = pos1_up(a)%n_shells                                          ! valence shell UP
              if ((pos1_up(a)%elements(1:1) == 'H').and.(pos1_up(a)%elements(1:2).ne.'He')) then                        ! for H bonds -> place FOD closer to H (0.85*bond length)
                pos1_up(a)%point_x_y_z(c,bond_count_up(a),:) = pos1_up(b)%center_x_y_z(:) + 0.85D0*bond_vector(:)
                bond_count_up(a) = bond_count_up(a) + 1
              else if ((pos1_up(b)%elements(1:1) == 'H').and.(pos1_up(b)%elements(1:2).ne.'He')) then
                pos1_up(a)%point_x_y_z(c,bond_count_up(a),:) = pos1_up(b)%center_x_y_z(:) + 0.15D0*bond_vector(:)
                bond_count_up(a) = bond_count_up(a) + 1
              else                                                             ! If not H -> place at the center of the bond
                pos1_up(a)%point_x_y_z(c,bond_count_up(a),:) = bond_center(:)
                bond_count_up(a) = bond_count_up(a) + 1
              end if
            else                                                               ! Add DN FOD
              c = pos1_dn(a)%n_shells                                          ! valence shell DN
              if ((pos1_up(a)%elements(1:1) == 'H').and.(pos1_up(a)%elements(1:2).ne.'He')) then                        ! for H bonds -> place FOD closer to H (0.85*bond length)
                pos1_dn(a)%point_x_y_z(c,bond_count_dn(a),:) = pos1_dn(b)%center_x_y_z(:) + 0.85D0*bond_vector(:)
                bond_count_dn(a) = bond_count_dn(a) + 1
              else if ((pos1_up(b)%elements(1:1) == 'H').and.(pos1_up(b)%elements(1:2).ne.'He')) then
                pos1_dn(a)%point_x_y_z(c,bond_count_dn(a),:) = pos1_dn(b)%center_x_y_z(:) + 0.15D0*bond_vector(:)
                bond_count_dn(a) = bond_count_dn(a) + 1
              else                                                             ! If not H -> place at the center of the bond
                pos1_dn(a)%point_x_y_z(c,bond_count_dn(a),:) = bond_center(:)
                bond_count_dn(a) = bond_count_dn(a) + 1
              end if
            end if

            
          !!!!!!!!!!!!!!!!!!!!!!
          ! MULTIPLE BOND FODs !
          !!!!!!!!!!!!!!!!!!!!!!
          ! Take perpendicular vector to the bond vector -> is perpendicular to the bond axis
          ! Use this vector (and a given radius) to place FODs perpendicular to the bond (vector applied to the bond center!)
          ! Rotate these points around the bond vector using MC to minimize their 1/r contribution
          !!!!!!!!!!!!!!
          ! UP CHANNEL !
          !!!!!!!!!!!!!! 
          else if (con_mat(a,b) > 1) then
            if (a < b) then                                                    ! Add UP FOD 
              do f = 1, con_mat(a,b)
                c = pos1_up(a)%n_shells                                        ! valence shell UP
                !
                ! NEW: 
                ! get bond FODs via structural motifs
                ! Rotate them into bond_vector to have them perpendicular to the bond axis
                ! Use different structual motifs than for core FODs, which will be different from 4 points on
                ! Get perpendicular vector corresponding to the structural motif -> use this to rotate the motif perpendicular to 
                ! the bond axis 
                !
                call struct_motif_bond_lone(con_mat(a,b),f,pos1_up(a)%r_theta_phi(c,bond_count_up(a),1)*scale_r, &
                                            bond_center,pos1_up(a)%point_x_y_z(c,bond_count_up(a),:),perpendicular_vec_motif)
                bond_count_up(a) = bond_count_up(a) + 1
              end do

              !!!!!! 
              ! For double bonds in a planar environment (atom a OR atom b are in a planar environemnt)
              !   - perpendicular vector to molecular plane
              !   - orient FODs along this vector
              !!!!!
              if ((con_mat(a,b)==2).and.((is_planar_linear(a)==1).or.(is_planar_linear(b)==1))) then
                !
                ! get cross product of two vectors to adjacent atoms -> cross product will give a perpendicular vector
                ! 
                allocate(tmp_vectors(2,size(pos1_up)))
                tmp_vectors(1,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
                tmp_vectors(2,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
                counter = 0
                !
                ! Distinguish between which center is in a planar environment
                !
                if (is_planar_linear(a)==1) then
                  loop21: do d = 1, size(pos1_up)                                                                    ! for each other atom!
                    if (con_mat(a,d) /= 0) then                                                                      ! if there is a bond between atom a and atom b -> get bond vector
                      counter = counter + 1
                      tmp_vectors(counter,:) = (pos1_up(a)%center_x_y_z(:) - pos1_up(d)%center_x_y_z(:))
                    end if
                    if (counter == 2) then                                                                           ! two vectors for cross product
                      tmp_vector(:) = tmp_vectors(1,:)                                                               ! define bond vector (around which multiple FODs will be rotated)
                      !
                      ! create normal vector. Cross product -> Perpendicular vector
                      !
                      perpendicular_vec(1) = tmp_vectors(1,2)*tmp_vectors(2,3) - tmp_vectors(1,3)*tmp_vectors(2,2)
                      perpendicular_vec(2) = tmp_vectors(1,3)*tmp_vectors(2,1) - tmp_vectors(1,1)*tmp_vectors(2,3)
                      perpendicular_vec(3) = tmp_vectors(1,1)*tmp_vectors(2,2) - tmp_vectors(1,2)*tmp_vectors(2,1)
                      exit loop21
                    end if
                  end do loop21
                !
                ! If atom b is in the planar environment
                !
                else
                  loop22: do d = 1, size(pos1_up)                                                                    ! for each other atom!
                    if (con_mat(b,d) /= 0) then                                                                      ! if there is a bond between atom a and atom b -> get bond vector
                      counter = counter + 1
                      tmp_vectors(counter,:) = (pos1_up(b)%center_x_y_z(:) - pos1_up(d)%center_x_y_z(:))
                    end if
                    if (counter == 2) then                                                                           ! two vectors for cross product
                      tmp_vector(:) = tmp_vectors(1,:)                                                               ! define bond vector (around which multiple FODs will be rotated)
                      !
                      ! create normal vector. Cross product -> Perpendicular vector
                      !
                      perpendicular_vec(1) = tmp_vectors(1,2)*tmp_vectors(2,3) - tmp_vectors(1,3)*tmp_vectors(2,2)
                      perpendicular_vec(2) = tmp_vectors(1,3)*tmp_vectors(2,1) - tmp_vectors(1,1)*tmp_vectors(2,3)
                      perpendicular_vec(3) = tmp_vectors(1,1)*tmp_vectors(2,2) - tmp_vectors(1,2)*tmp_vectors(2,1)
                      exit loop22
                    end if
                  end do loop22
                end if
                !
                ! normalize vector
                !
                perpendicular_vec(:) = perpendicular_vec(:)/sqrt(sum(perpendicular_vec(:)**2))
                ! 
                ! assign center for FOD generation.
                !
                pos1_up(a)%point_x_y_z(c,bond_count_up(a)-1,:) = bond_center(:) + &
                        & pos1_up(a)%r_theta_phi(c,bond_count_up(a)-1,1)*scale_r*perpendicular_vec(:)
                pos1_up(a)%point_x_y_z(c,bond_count_up(a)-2,:) = bond_center(:) - &
                        & pos1_up(a)%r_theta_phi(c,bond_count_up(a)-2,1)*scale_r*perpendicular_vec(:)
                deallocate(tmp_vectors)

              !
              ! Other than double bond in planar environment (e.g., SO2)
              !
              else
                !
                ! Rotate the perpendicular vector of the structural motif into the bond_vector -> perpendicular to the bond axis
                !
                ! Get rotation matrix
                !
                call create_rotMat_vec1_into_vec2(full_rot,perpendicular_vec_motif,bond_vector)
                !
                ! Rotate all points
                !
                do f = 1, con_mat(a,b)
                  call rotate_pos(full_rot,pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:),&
                               bond_center,pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:))
                  pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:) = pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)  ! restore the pos1 array
                end do
              end if

              ! DO NOT ROTATE THEM ANY FURTHER !!


              !!!! Rotate the point around the bond vector (bond axis).
              !!!!
              !!!ave_dist1 = 100000.0
              !!!do d = 1, cycles
              !!!  do f = 1, con_mat(a,b)
              !!!    pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:) = pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)      ! store original positions
              !!!    call rotate_around_axis(bond_vector,bond_center,pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:),step_size)
              !!!  end do
              !!!  !
              !!!  ! 1/r calculation.
              !!!  !
              !!!  ave_dist2 = 0.0
              !!!  do e = 1, con_mat(a,b)-1
              !!!    do f = e+1, con_mat(a,b)
              !!!      ave_dist2 = ave_dist2 + 1.0D0/sqrt(sum((pos1_up(a)%point_x_y_z(c,bond_count_up(a) - e,:) - &
              !!!                                          & pos1_up(a)%point_x_y_z(c,bond_count_up(a) - f,:))**2))
              !!!    end do
              !!!  end do
              !!!  !
              !!!  ! In addition, evaluate the 1/r to all atoms the corresponding atom is bonded to (and to the atom itself) -> better symmetry
              !!!  !
              !!!  do g = 1,size(pos1_up) 
              !!!    if ((con_mat(a,g)) /= 0 .or. (con_mat(g,a) /= 0) .or. (g == a)) then
              !!!      do e = 1, con_mat(a,b)
              !!!        tmp_dist = sqrt(sum((pos1_up(a)%point_x_y_z(c,bond_count_up(a) - e,:) - &
              !!!                                              & pos1_up(g)%center_x_y_z(:))**2))
              !!!        if (periodic) then                                                     ! In a peridoic system, take cell vectors into account
              !!!          do f = 1, 3
              !!!            do h = 1, 3
              !!!              do i = 1, 3
              !!!                if (sqrt(sum((pos1_up(a)%point_x_y_z(c,bond_count_up(a) - e,:) - pos1_up(g)%center_x_y_z(:) + &
              !!!                             (f-2)*cell_a(:) + (h-2)*cell_b(:) + (i-2)*cell_c(:))**2)) < tmp_dist) then
              !!!                  tmp_dist = sqrt(sum((pos1_up(a)%point_x_y_z(c,bond_count_up(a) - e,:)-pos1_up(g)%center_x_y_z(:)+&
              !!!                             (f-2)*cell_a(:) + (h-2)*cell_b(:) + (i-2)*cell_c(:))**2))
              !!!                end if
              !!!              end do
              !!!            end do
              !!!          end do
              !!!        end if
              !!!        ave_dist2 = ave_dist2 + 1.0D0/tmp_dist
              !!!      end do
              !!!    end if
              !!!    !
              !!!    ! In addition, use the atoms which the bonded atom is bonded to as well -> more robust. I.e. include all atoms in con_mat(g,:)
              !!!    !
              !!!    do j = 1,size(pos1_up)
              !!!      if ((con_mat(g,j)) /= 0 .or. (con_mat(j,g) /= 0)) then
              !!!        do e = 1, con_mat(a,b)
              !!!          tmp_dist = sqrt(sum((pos1_up(a)%point_x_y_z(c,bond_count_up(a) - e,:) - &
              !!!                                                & pos1_up(j)%center_x_y_z(:))**2))
              !!!          if (periodic) then                                                     ! In a peridoic system, take cell vectors into account
              !!!            do f = 1, 3
              !!!              do h = 1, 3
              !!!                do i = 1, 3
              !!!                  if (sqrt(sum((pos1_up(a)%point_x_y_z(c,bond_count_up(a) - e,:) - pos1_up(j)%center_x_y_z(:) + &
              !!!                               (f-2)*cell_a(:) + (h-2)*cell_b(:) + (i-2)*cell_c(:))**2)) < tmp_dist) then
              !!!                    tmp_dist = sqrt(sum((pos1_up(a)%point_x_y_z(c,bond_count_up(a)-e,:)-pos1_up(j)%center_x_y_z(:)+&
              !!!                               (f-2)*cell_a(:) + (h-2)*cell_b(:) + (i-2)*cell_c(:))**2))
              !!!                  end if
              !!!                end do
              !!!              end do
              !!!            end do
              !!!          end if
              !!!          ave_dist2 = ave_dist2 + 1.0D0/tmp_dist
              !!!        end do
              !!!      end if
              !!!    end do
              !!!    ! END NEW
              !!!  end do
              !!!  ! 
              !!!  ! Keep configuration?
              !!!  !
              !!!  if (ave_dist2 < ave_dist1) then
              !!!    do f = 1, con_mat(a,b)
              !!!      pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:) = pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)
              !!!    end do
              !!!    ave_dist1 = ave_dist2
              !!!  else
              !!!    do f = 1, con_mat(a,b)
              !!!      pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:) = pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)
              !!!    end do
              !!!  end if
              !!!end do
              !
              !!
              ! KT: HERE  why doesn't this work for CO2, LT guess?
              !         - O are not identified as linear
              !         - if enforced, lone FODs move -> WHY?
              !         - if this is fixed: assign all atoms with one neighbour as linear
              !    RETHINK THE FOLLOWING!
              !
              !         Problem: We analyze 1/r maybe to initial positions of bond FODs per atom -> no good
              !         - MAYBE we have to do this outside the current loop, once everything is set!!!
              !                 TO BE DONE
              !                        Careful: Only compare to bond FODs!! Lone FODs have not been set yet!!!!!!!!!!

              !
              ! analyze whether atoms is in an linear environemnt.
              ! If so -> minimize 1/r to neighbouring FODs via rotations
              !
              if (is_planar_linear(a) == 2) then
                ave_dist1 = 10000000.0
                do d = 1, cycles
                  ave_dist2 = 0.0
                  !
                  ! generate rotation matrix for bond rotation. Rotate positions
                  ! Rotate ALL positions in the same way
                  !
                  call create_rotMat_bond(full_rot,bond_vector,step_size)
                  do e = 1, con_mat(a,b)
                    call rotate_pos(full_rot, pos1_up(a)%point_x_y_z(c,bond_count_up(a)-e,:), &
                                  & bond_center, pos2_up(a)%point_x_y_z(c,bond_count_up(a)-e,:))
                    !
                    ! evaluate 1/r
                    !
                    do f = 1, size(pos1_up)
                      if (con_mat(a,f) /= 0) then
                        i = pos1_up(f)%n_shells
                        do g = 1, pos1_up(f)%n_points(i)
                          ave_dist2 = ave_dist2 + 1.0D0/sqrt(sum((pos2_up(a)%point_x_y_z(c,bond_count_up(a) - e,:) - &
                                                       & pos2_up(f)%point_x_y_z(i,g,:))**2))  ! maybe only use bond FODs here...
                                                                                              ! maybe this needs tobe done outside
                                                                                              ! the current loop
                        end do
                      end if
                    end do
                  end do
                  !
                  ! Keep configuration?
                  !
                  if (ave_dist2 < ave_dist1) then
                    do f = 1, con_mat(a,b)
                      pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:) = pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)
                    end do
                    ave_dist1 = ave_dist2
                  else
                    do f = 1, con_mat(a,b)
                      pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:) = pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)
                    end do
                  end if
                end do
              end if

              !
              ! If same number of UP and DN FODs in the bond -> just pair them right here (regarding the respective other atoms!)
              !
              if (con_mat(a,b) == con_mat(b,a)) then
                do f = 1, con_mat(a,b)
                  g = pos1_dn(b)%n_shells
                  pos1_dn(b)%point_x_y_z(g,bond_count_dn(b),:) = pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)
                  bond_count_dn(b) = bond_count_dn(b) + 1
                end do
              end if

            !!!!!!!!!!!!!!
            ! DN CHANNEL !
            !!!!!!!!!!!!!!
            else
              if (con_mat(a,b) == con_mat(b,a)) then                            ! same number of UP and DN FODs in the bond -> nothing to do (already paired)
                continue
              else
                do f = 1, con_mat(a,b)
                  c = pos1_dn(a)%n_shells                                       ! valence shell DN
                  ! 
                  ! get bond FODs via structural motifs
                  ! Rotate them into bond_vector to have them perpendicular to the bond axis
                  ! Use different structual motifs than for core FODs, which will be different from 4 points on
                  ! Get perpendicular vector corresponding to the structural motif -> use this to rotate the motif perpendicular to 
                  ! the bond axis 
                  !
                  call struct_motif_bond_lone(con_mat(a,b),f,pos1_dn(a)%r_theta_phi(c,bond_count_dn(a),1)*scale_r, &
                                              bond_center,pos1_dn(a)%point_x_y_z(c,bond_count_dn(a),:),perpendicular_vec_motif)
                  bond_count_dn(a) = bond_count_dn(a) + 1
                end do
                !!!!!! 
                ! For double bonds in a planar environment (atom a OR atom b are in a planar environment)
                !   - perpendicular vector to molecular plane
                !   - orient FODs along this vector
                !!!!!
                if ((con_mat(a,b)==2).and.((is_planar_linear(a)==1).or.((is_planar_linear(b)==1)))) then
                  !
                  ! get cross product of two vectors to adjacent atoms -> cross product will give a perpendicular vector
                  ! 
                  allocate(tmp_vectors(2,size(pos1_dn)))
                  tmp_vectors(1,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
                  tmp_vectors(2,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
                  counter = 0
                  !
                  ! Distinguish between which center is in a planar environment
                  !
                  if (is_planar_linear(a)==1) then
                    loop23: do d = 1, size(pos1_dn)                                                                    ! for each other atom!
                      if (con_mat(a,d) /= 0) then                                                                      ! if there is a bond between atom a and atom b -> get bond vector
                        counter = counter + 1
                        tmp_vectors(counter,:) = (pos1_dn(a)%center_x_y_z(:) - pos1_dn(d)%center_x_y_z(:))
                      end if
                      if (counter == 2) then                                                                           ! two vectors for cross product
                        tmp_vector(:) = tmp_vectors(1,:)                                                               ! define bond vector (around which multiple FODs will be rotated)
                        !
                        ! create normal vector. Cross product -> Perpendicular vector
                        !
                        perpendicular_vec(1) = tmp_vectors(1,2)*tmp_vectors(2,3) - tmp_vectors(1,3)*tmp_vectors(2,2)
                        perpendicular_vec(2) = tmp_vectors(1,3)*tmp_vectors(2,1) - tmp_vectors(1,1)*tmp_vectors(2,3)
                        perpendicular_vec(3) = tmp_vectors(1,1)*tmp_vectors(2,2) - tmp_vectors(1,2)*tmp_vectors(2,1)
                        exit loop23
                      end if
                    end do loop23
                  !
                  ! If atom b is in the planar environment
                  !
                  else
                    loop24: do d = 1, size(pos1_dn)                                                                    ! for each other atom!
                      if (con_mat(b,d) /= 0) then                                                                      ! if there is a bond between atom a and atom b -> get bond vector
                        counter = counter + 1
                        tmp_vectors(counter,:) = (pos1_dn(b)%center_x_y_z(:) - pos1_dn(d)%center_x_y_z(:))
                      end if
                      if (counter == 2) then                                                                           ! two vectors for cross product
                        tmp_vector(:) = tmp_vectors(1,:)                                                               ! define bond vector (around which multiple FODs will be rotated)
                        !
                        ! create normal vector. Cross product -> Perpendicular vector
                        !
                        perpendicular_vec(1) = tmp_vectors(1,2)*tmp_vectors(2,3) - tmp_vectors(1,3)*tmp_vectors(2,2)
                        perpendicular_vec(2) = tmp_vectors(1,3)*tmp_vectors(2,1) - tmp_vectors(1,1)*tmp_vectors(2,3)
                        perpendicular_vec(3) = tmp_vectors(1,1)*tmp_vectors(2,2) - tmp_vectors(1,2)*tmp_vectors(2,1)
                        exit loop24
                      end if
                    end do loop24
                  end if
                  !
                  ! normalize vector
                  !
                  perpendicular_vec(:) = perpendicular_vec(:)/sqrt(sum(perpendicular_vec(:)**2))
                  ! 
                  ! assign center for FOD generation. Average the radii of both atoms
                  !
                  pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-1,:) = bond_center(:) + &
                          & pos1_dn(a)%r_theta_phi(c,bond_count_dn(a)-1,1)*scale_r*perpendicular_vec(:)
                  pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-2,:) = bond_center(:) - &
                          & pos1_dn(a)%r_theta_phi(c,bond_count_dn(a)-2,1)*scale_r*perpendicular_vec(:)
                  deallocate(tmp_vectors)
                !
                ! Other than double bond in a planar environment
                !
                else
                  !
                  ! Rotate the perpendicular vector of the structural motif into the bond_vector -> perpendicular to the bond axis
                  !
                  ! Get rotation matrix
                  !
                  call create_rotMat_vec1_into_vec2(full_rot,perpendicular_vec_motif,bond_vector)
                  !
                  ! Rotate all points
                  !
                  do f = 1, con_mat(a,b)
                    call rotate_pos(full_rot,pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:),&
                                 bond_center,pos2_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:))
                    pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:) = pos2_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:)  ! restore the pos1 array
                  end do
                end if                  


                !!!!
                !!!! Rotate the point around the bond vector (bond axis). 
                !!!!
                !!!ave_dist1 = 100000.0
                !!!do d = 1, cycles
                !!!  do f = 1, con_mat(a,b)
                !!!    pos2_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:) = pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:)    ! store original pos
                !!!    call rotate_around_axis(bond_vector,bond_center, & 
                !!!                          & pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:),step_size)
                !!!  end do
                !!!  !
                !!!  ! 1/r calculation
                !!!  !
                !!!  ave_dist2 = 0.0
                !!!  do e = 1, con_mat(a,b)-1
                !!!    do f = e+1, con_mat(a,b)
                !!!      ave_dist2 = ave_dist2 + 1.0D0/sqrt(sum((pos1_dn(a)%point_x_y_z(c,bond_count_dn(a) - e,:) - &
                !!!                              & pos1_dn(a)%point_x_y_z(c,bond_count_dn(a) - f,:))**2))
                !!!    end do
                !!!  end do
                !!!  !
                !!!  ! In addition, evaluate the 1/r to all atoms the corresponding atom is bonded to (and to the atom itself) -> better symmetry
                !!!  !
                !!!  do g = 1,size(pos1_dn)
                !!!    if ((con_mat(a,g)) /= 0 .or. (con_mat(g,a) /= 0) .or. (g == a)) then
                !!!      do e = 1, con_mat(a,b)
                !!!        tmp_dist = sqrt(sum((pos1_dn(a)%point_x_y_z(c,bond_count_dn(a) - e,:) - &
                !!!                                              & pos1_dn(g)%center_x_y_z(:))**2))
                !!!        if (periodic) then                                                     ! In a peridoic system, take cell vectors into account
                !!!          do f = 1, 3
                !!!            do h = 1, 3
                !!!              do i = 1, 3
                !!!                if (sqrt(sum((pos1_dn(a)%point_x_y_z(c,bond_count_dn(a) - e,:) - pos1_dn(g)%center_x_y_z(:) + &
                !!!                             (f-2)*cell_a(:) + (h-2)*cell_b(:) + (i-2)*cell_c(:))**2)) < tmp_dist) then
                !!!                  tmp_dist = sqrt(sum((pos1_dn(a)%point_x_y_z(c,bond_count_dn(a) - e,:)-pos1_dn(g)%center_x_y_z(:)+&
                !!!                             (f-2)*cell_a(:) + (h-2)*cell_b(:) + (i-2)*cell_c(:))**2))
                !!!                end if
                !!!              end do
                !!!            end do
                !!!          end do
                !!!        end if
                !!!        ave_dist2 = ave_dist2 + 1.0D0/tmp_dist  
                !!!      end do
                !!!    end if
                !!!    !
                !!!    ! In addition, use the atoms which the bonded atom is bonded to as well -> more robust. I.e. include all atoms in con_mat(g,:)
                !!!    !
                !!!    do j = 1,size(pos1_dn)
                !!!      if ((con_mat(g,j)) /= 0 .or. (con_mat(j,g) /= 0)) then

                !!!        do e = 1, con_mat(a,b)
                !!!          tmp_dist = sqrt(sum((pos1_dn(a)%point_x_y_z(c,bond_count_dn(a) - e,:) - &
                !!!                                                & pos1_dn(j)%center_x_y_z(:))**2))
                !!!          if (periodic) then                                                     ! In a peridoic system, take cell vectors into account
                !!!            do f = 1, 3
                !!!              do h = 1, 3
                !!!                do i = 1, 3
                !!!                  if (sqrt(sum((pos1_dn(a)%point_x_y_z(c,bond_count_dn(a) - e,:) - pos1_dn(j)%center_x_y_z(:) + &
                !!!                               (f-2)*cell_a(:) + (h-2)*cell_b(:) + (i-2)*cell_c(:))**2)) < tmp_dist) then
                !!!                    tmp_dist = sqrt(sum((pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-e,:)-pos1_dn(j)%center_x_y_z(:)+&
                !!!                               (f-2)*cell_a(:) + (h-2)*cell_b(:) + (i-2)*cell_c(:))**2))
                !!!                  end if
                !!!                end do
                !!!              end do
                !!!            end do
                !!!          end if
                !!!          ave_dist2 = ave_dist2 + 1.0D0/tmp_dist
                !!!        end do
                !!!      end if
                !!!    end do
                !!!    ! END NEW
                !!!  end do
                !!!  !
                !!!  ! Keep configuration? 
                !!!  !
                !!!  if (ave_dist2 < ave_dist1) then
                !!!    do f = 1, con_mat(a,b)
                !!!      pos2_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:) = pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:)
                !!!    end do
                !!!    ave_dist1 = ave_dist2
                !!!  else
                !!!    do f = 1, con_mat(a,b)
                !!!      pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:) = pos2_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:)
                !!!    end do
                !!!  end if
                !!!end do
                !
                ! analyze whether atoms is in an linear environemnt.
                ! If so -> minimize 1/r to neighbouring FODs via rotations
                !
                if (is_planar_linear(a) == 2) then
                  ave_dist1 = 10000000.0
                  do d = 1, cycles
                    ave_dist2 = 0.0
                    !
                    ! generate rotation matrix for bond rotation. Rotate positions
                    !
                    call create_rotMat_bond(full_rot,bond_vector,step_size)
                    do e = 1, con_mat(a,b)
                      call rotate_pos(full_rot, pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-e,:), &
                                    & bond_center, pos2_dn(a)%point_x_y_z(c,bond_count_dn(a)-e,:))
                      !
                      ! evaluate 1/r
                      !
                      do f = 1, size(pos1_dn)
                        if (con_mat(a,f) /= 0) then
                          i = pos1_dn(f)%n_shells
                          do g = 1, pos1_dn(f)%n_points(i)
                            ave_dist2 = ave_dist2 + 1.0D0/sqrt(sum((pos2_dn(a)%point_x_y_z(c,bond_count_dn(a) - e,:) - &
                                                         & pos2_dn(f)%point_x_y_z(i,g,:))**2))
                          end do
                        end if
                      end do
                    end do
                    !
                    ! Keep configuration?
                    !
                    if (ave_dist2 < ave_dist1) then
                      do f = 1, con_mat(a,b)
                        pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:) = pos2_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:)
                      end do
                      ave_dist1 = ave_dist2
                    else
                      do f = 1, con_mat(a,b)
                        pos2_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:) = pos1_dn(a)%point_x_y_z(c,bond_count_dn(a)-f,:)
                      end do
                    end if
                  end do
                end if
              end if
            end if
          end if
        end if
      end do
    end if
  end do


!! KT: Aug 17 2021: Try to fix this....
!!!!!  !
!!!!!  ! ROTATE BOND FODs if linear environment
!!!!!  !
!!!!!  do a = 1, size(pos1_up)
!!!!!    do b = 1, size(pos1_up)
!!!!!      if (a /= b) then
!!!!!        ! If so -> minimize 1/r to neighbouring bond FODs via rotations
!!!!!        !
!!!!!        if (is_planar_linear(a) == 2) then
!!!!!          !
!!!!!          ! get bond center and vector describing the bond
!!!!!          !
!!!!!          bond_center(:) = (pos1_up(a)%center_x_y_z(:) + pos1_up(b)%center_x_y_z(:))/2.0D0
!!!!!          bond_vector(:) =  pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) ! vector from b to a          
!!!!!          if (periodic) then                                                        ! In a peridoic system, take cell vectors into account
!!!!!            do c = 1, 3
!!!!!              do d = 1, 3
!!!!!                do e = 1, 3
!!!!!                  if (sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
!!!!!                               (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:))**2)) < &
!!!!!                               (sqrt(sum(bond_vector(:)**2)))) then
!!!!!                    bond_center(:) = (pos1_up(a)%center_x_y_z(:) + pos1_up(b)%center_x_y_z(:) + &
!!!!!                                     (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:))/2.0D0
!!!!!                    bond_vector(:) = pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
!!!!!                                     (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:)
!!!!!                  end if
!!!!!                end do
!!!!!              end do
!!!!!            end do
!!!!!          end if
!!!!!
!!!!!          c = pos1_up(a)%n_shells                                        ! valence shell UP
!!!!!
!!!!!          ave_dist1 = 10000000.0
!!!!!          do d = 1, cycles
!!!!!            ave_dist2 = 0.0
!!!!!            !
!!!!!            ! generate rotation matrix for bond rotation. Rotate positions
!!!!!            ! Rotate ALL positions in the same way
!!!!!            !
!!!!!            call create_rotMat_bond(full_rot,bond_vector,step_size)
!!!!!            do e = 1, con_mat(a,b)
!!!!!              call rotate_pos(full_rot, pos1_up(a)%point_x_y_z(c,bond_count_up(a)-e,:), &
!!!!!                            & bond_center, pos2_up(a)%point_x_y_z(c,bond_count_up(a)-e,:))
!!!!!              !
!!!!!              ! evaluate 1/r
!!!!!              !   1/r with valence FODs of the atom itself
!!!!!              do g = 1, pos1_up(a)%n_points(c)
!!!!!                ! exclude evaluation with itself
!!!!!                if (g /= bond_count_up(a) - e) then
!!!!!                  ave_dist2 = ave_dist2 + 1.0D0/sqrt(sum((pos2_up(a)%point_x_y_z(c,bond_count_up(a) - e,:) - &
!!!!!                                               & pos2_up(a)%point_x_y_z(c,g,:))**2))  
!!!!!                end if
!!!!!              end do
!!!!!            end do
!!!!!            !
!!!!!            ! Keep configuration?
!!!!!            !
!!!!!            if (ave_dist2 < ave_dist1) then
!!!!!              do f = 1, con_mat(a,b)
!!!!!                pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:) = pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)
!!!!!              end do
!!!!!              ave_dist1 = ave_dist2
!!!!!            else
!!!!!              do f = 1, con_mat(a,b)
!!!!!                pos2_up(a)%point_x_y_z(c,bond_count_up(a)-f,:) = pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)
!!!!!              end do
!!!!!            end if
!!!!!          end do
!!!!!        end if
!!!!!
!!!!!        !
!!!!!        ! If same number of UP and DN FODs in the bond -> just pair them right here (regarding the respective other atoms!) and
!!!!!        ! itself 
!!!!!        !
!!!!!        if (con_mat(a,b) == con_mat(b,a)) then
!!!!!          do f = 1, con_mat(a,b)
!!!!!            g = pos1_dn(b)%n_shells
!!!!!            pos1_dn(b)%point_x_y_z(g,bond_count_dn(b),:) = pos1_up(a)%point_x_y_z(c,bond_count_up(a)-f,:)
!!!!!            bond_count_dn(b) = bond_count_dn(b) + 1
!!!!!          end do
!!!!!        end if
!!!!!      end if
!!!!!    end do
!!!!!  end do 



!
! OVERWRITE ANY EXISTING pos2
!
  do a = 1, size(pos1_up)                         ! for each atom!
    do b = 1, pos1_up(a)%n_shells                 ! UP CHANNEL
      do c = 1, pos1_up(a)%n_points(b)
        pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
      end do
    end do
  end do
  do a = 1, size(pos1_dn)                         ! for each atom!
    do b = 1, pos1_dn(a)%n_shells                 ! DN CHANNEL
      do c = 1, pos1_dn(a)%n_points(b)
        pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
      end do
    end do
  end do

















!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!! 2. get lone FODs !!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Idea: get all bond vectors to a given atom. Sum them up, normalize the resulting vector 
! => In the opposite direction of this vector, the lone FODs will be (at least in the way how the bond vectors are defined)
! Optimize the lone FODs in the same way as the bond FODs
! If an atom has no bonds -> optimize the number of lone FODs individually
!

  do a = 1, size(pos1_up)                                                      ! for each atom
    if (sum(lone_fods(a,:)) == 0) then                                         ! if there are no lone FODs -> skip everything else
      continue
    else
      !
      ! If there are no bonds to this atoms -> optimize valence according to that atom
      !
      if (sum(con_mat(a,:)) == 0) then
        !!!!!!!!!!!!!!
        ! UP CHANNEL !
        !!!!!!!!!!!!!!
        !
        ! Use structual motifs instead of getting FODs via MC
        !
        b = pos1_up(a)%n_shells                                                       ! valence shell UP
        d = 0
        do c = pos1_up(a)%n_points(b)-lone_fods(a,1)+1, pos1_up(a)%n_points(b)      ! lone FODs only
          d = d + 1
          ! 
          ! get lone FODs via structural motifs
          ! Here, Use same structual motifs than for core FODs
          !
          call struct_motif(lone_fods(a,1),d,pos1_up(a)%r_theta_phi(b,c,1)*scale_r, &
                            pos1_up(a)%center_x_y_z,pos1_up(a)%point_x_y_z(b,c,:))
        end do
        !
        ! Rotate the point around the atom. Optimize with MC. 
        !
        ave_dist1_up = 100000.0
        do j = 1, cycles
          !
          ! Get a rotation matrix
          ! Use one rotation matrix for ALL points -> keep symmetry
          !
          call create_rotMat(full_rot,step_size)
          !
          ! Rotate
          !
          b = pos1_up(a)%n_shells
          do c = pos1_up(a)%n_points(b)-lone_fods(a,1)+1, pos1_up(a)%n_points(b)
            call rotate_pos(full_rot, pos1_up(a)%point_x_y_z(b,c,:), pos1_up(a)%center_x_y_z, &
                                      pos2_up(a)%point_x_y_z(b,c,:))
          end do
          !
          ! EVAL UP
          ! 1/r calculation. UP channel. Lone FODs against all atoms to get symmetry right
          ! valence contributions only.
          ave_dist2_up = 0.0
          b = pos2_up(a)%n_shells
          do c = pos2_up(a)%n_points(b)-lone_fods(a,1)+1, pos2_up(a)%n_points(b)
            do d = 1,size(pos1_up)                                                                                     ! Take the 1/r to all atoms -> better symmetry
              ave_dist2_up = ave_dist2_up + 1.0D0/sqrt(sum((pos2_up(a)%point_x_y_z(b,c,:) - &                            ! change '+' to '-' to place the lone FODs towards the other atoms
                                                        & pos1_up(d)%center_x_y_z(:))**2))
            end do
          end do
          !
          ! Keep configuration?
          !
          if (ave_dist2_up < ave_dist1_up) then
            do c = pos1_up(a)%n_points(b)-lone_fods(a,1)+1, pos1_up(a)%n_points(b)
              pos1_up(a)%point_x_y_z(b,c,:) = pos2_up(a)%point_x_y_z(b,c,:)
              pos1_up(a)%r_theta_phi(b,c,:) = pos2_up(a)%r_theta_phi(b,c,:)
            end do
            ave_dist1_up = ave_dist2_up
          else
            do c = pos1_up(a)%n_points(b)-lone_fods(a,1)+1, pos1_up(a)%n_points(b)
              pos2_up(a)%point_x_y_z(b,c,:) = pos1_up(a)%point_x_y_z(b,c,:)                                            ! reset position2
              pos2_up(a)%r_theta_phi(b,c,:) = pos1_up(a)%r_theta_phi(b,c,:)
            end do
          end if
        end do
        ! 
        ! If same number of UP and DN FODs in the lone pair -> just pair them right here
        ! it is ugly right now, but it works
        !
        if (lone_fods(a,1) == lone_fods(a,2)) then
          b = pos1_up(a)%n_shells
          g = pos1_dn(a)%n_shells
          do h = 1, lone_fods(a,1)
            c = pos1_up(a)%n_points(b) - (h-1)
            i = pos1_dn(a)%n_points(b) - (h-1)
            pos1_dn(a)%point_x_y_z(g,i,:) = pos1_up(a)%point_x_y_z(b,c,:)
            pos1_dn(a)%r_theta_phi(g,i,:) = pos1_up(a)%r_theta_phi(b,c,:)
          end do

        !!!!!!!!!!!!!!
        ! DN CHANNEL !
        !!!!!!!!!!!!!!
        else
          !
          ! Rotate the point around the atom. Optimize with MC. 
          !
          !
          ! Use structual motifs instead of getting FODs via MC
          !
          b = pos1_dn(a)%n_shells                                                       ! valence shell DN
          d = 0
          do c = pos1_dn(a)%n_points(b)-lone_fods(a,2)+1, pos1_dn(a)%n_points(b)      ! lone FODs only
            d = d + 1
            ! 
            ! get lone FODs via structural motifs
            ! Here, Use same structual motifs as for core FODs
            !
            call struct_motif(lone_fods(a,2),d,pos1_dn(a)%r_theta_phi(b,c,1)*scale_r, &
                              pos1_dn(a)%center_x_y_z,pos1_dn(a)%point_x_y_z(b,c,:))
          end do
          !
          ! Rotate the point around the atom. Optimize with MC. 
          !
          ave_dist1_up = 100000.0
          do j = 1, cycles
            !
            ! Get a rotation matrix
            ! Use one rotation matrix for ALL points -> keep symmetry
            !
            call create_rotMat(full_rot,step_size)
            !
            ! Rotate
            !
            b = pos1_dn(a)%n_shells
            do c = pos1_dn(a)%n_points(b)-lone_fods(a,2)+1, pos1_dn(a)%n_points(b)
              call rotate_pos(full_rot, pos1_dn(a)%point_x_y_z(b,c,:), pos1_dn(a)%center_x_y_z, &
                                        pos2_dn(a)%point_x_y_z(b,c,:))
            end do
            !
            ! EVAL DN
            ! 1/r calculation. DN channel. Lone FODs against all atoms to get symmetry right
            ! valence contributions only.
            ave_dist2_dn = 0.0
            b = pos2_dn(a)%n_shells
            do c = pos2_dn(a)%n_points(b)-lone_fods(a,2)+1, pos2_dn(a)%n_points(b)
              do d = 1,size(pos1_dn)                                                                                    ! Take the 1/r to all atoms -> better symmetry
                ave_dist2_dn = ave_dist2_dn + 1.0D0/sqrt(sum((pos2_dn(a)%point_x_y_z(b,c,:) - &                           ! change '+' to '-' to place the lone FODs towards the other atoms
                                                          & pos1_dn(d)%center_x_y_z(:))**2))
              end do
            end do
            !
            ! Keep configuration?
            !
            if (ave_dist2_dn < ave_dist1_dn) then
              do c = pos1_dn(a)%n_points(b)-lone_fods(a,2)+1, pos1_dn(a)%n_points(b)
                pos1_dn(a)%point_x_y_z(b,c,:) = pos2_dn(a)%point_x_y_z(b,c,:)
                pos1_dn(a)%r_theta_phi(b,c,:) = pos2_dn(a)%r_theta_phi(b,c,:)
              end do
              ave_dist1_dn = ave_dist2_dn
            else
              do c = pos1_dn(a)%n_points(b)-lone_fods(a,2)+1, pos1_dn(a)%n_points(b)
                pos2_dn(a)%point_x_y_z(b,c,:) = pos1_dn(a)%point_x_y_z(b,c,:)                                          ! reset position2
                pos2_dn(a)%r_theta_phi(b,c,:) = pos1_dn(a)%r_theta_phi(b,c,:)
              end do
            end if
          end do
        end if

      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! If there are bonds to the specific atom ! 
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      else
        counter = 0
        bond_vector(:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)                                                   ! initialize bond vector
        do b = 1, size(pos1_up)                                                                                        ! for each other atom
          !
          ! get vector describing the bond. For each bond to an atom, as specified in con_mat
          !
          if (con_mat(a,b) /= 0) then                                                                                  ! for different atoms which are bonded (UP and DN)
            counter = counter + 1
            !
            ! get vector describing all bonds
            !
            if (periodic) then                                                                                         ! In a periodic system, take cell vectors into account
              tmp_vector(:) = (/ real(100.0,8),real(100.0,8),real(100.0,8) /)                                          ! temporary vector. Make ridiculously big -> minimizue afterwards
              do c = 1, 3
                do d = 1, 3
                  do e = 1, 3
                    if (sqrt(sum((pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                                 (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:))**2)) < &
                                 (sqrt(sum(tmp_vector(:)**2)))) then
                      tmp_vector(:) = pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:) + &
                                       (c-2)*cell_a(:) + (d-2)*cell_b(:) + (e-2)*cell_c(:)
                    end if
                  end do
                end do
              end do
              bond_vector(:) = bond_vector(:) + tmp_vector(:)
            else                                                                                                       ! in case of no periodicity:
              bond_vector(:) = bond_vector(:) + (pos1_up(a)%center_x_y_z(:) - pos1_up(b)%center_x_y_z(:))              ! vector from b to a
            end if
          end if
        end do
        !
        ! Check if the atom is in a planar or linear environment. If so -> lone FODs need to be out-of-plane
        !
        !
        ! Linear. Only the central atoms X (A-X-B) is defined as linear. the other are not assigned! Will be treated differently
        !
        if (is_planar_linear(a) == 2) then
          !
          ! For any other atoms: Get a vector describing a bond to this atom
          !
          allocate(tmp_vectors(2,size(pos1_up)))
          tmp_vectors(1,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
          tmp_vectors(2,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
          do d = 1, size(pos1_up)
            if (con_mat(a,d) /= 0) then
              tmp_vector(:) = pos1_up(a)%center_x_y_z(:) - pos1_up(d)%center_x_y_z(:)
            end if
          end do
          !
          ! Get a vector that is perpendicular to a bond vector (first call to per_vector) AND one that is perpendicular to this vector (second call should do that)
          !
          call per_vector(tmp_vector(:),pos1_up(a)%center_x_y_z(:),tmp_vectors(1,:))
          call per_vector(tmp_vectors(1,:),pos1_up(a)%center_x_y_z(:),tmp_vectors(2,:))
          ! 
          ! assign center for FOD generation
          !
          if (lone_fods(a,1) > 0) then
            f = pos1_up(a)%n_shells
            g = pos1_up(a)%n_points(f)-lone_fods(a,1)+1                                                      ! outermost shell -> get radius of that shell
            bond_center(:) = pos1_up(a)%center_x_y_z(:) + &
            & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*tmp_vectors(2,:)*pos1_up(a)%r_theta_phi(f,g,1)       ! UP channel, scale to number of lone FODs
          else if (lone_fods(a,2) > 0) then
            f = pos1_dn(a)%n_shells
            g = pos1_dn(a)%n_points(f)-lone_fods(a,2)+1
            bond_center(:) = pos1_dn(a)%center_x_y_z(:) + &
            & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*tmp_vectors(2,:)*pos1_dn(a)%r_theta_phi(f,g,1)       ! DN channel
          end if
          deallocate(tmp_vectors)
        ! 
        ! Planar and more than two bonds (like benzene, and excluding e.g. H2O)
        !
        else if ((is_planar_linear(a)==1).and.(counter > 2)) then ! more than two bonds
          !
          ! get cross product of two vectors to adjacent atoms -> cross product will give a perpendicular vector
          ! 
          allocate(tmp_vectors(2,size(pos1_up)))
          tmp_vectors(1,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
          tmp_vectors(2,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
          counter = 0
          loop2: do c = 1, size(pos1_up)                                                                     ! for each other atom!
            if (con_mat(a,c) /= 0) then                                                                      ! if there is a bond between atom a and atom b -> get bond vector
              counter = counter + 1
              tmp_vectors(counter,:) = (pos1_up(a)%center_x_y_z(:) - pos1_up(c)%center_x_y_z(:))
            end if
            if (counter == 2) then                                                                           ! two vectors for cross product
              tmp_vector(:) = tmp_vectors(1,:)                                                               ! define bond vector (around which multiple FODs will be rotated)
              !
              ! create normal vector. Cross product -> Perpendicular vector
              !
              perpendicular_vec(1) = tmp_vectors(1,2)*tmp_vectors(2,3) - tmp_vectors(1,3)*tmp_vectors(2,2)
              perpendicular_vec(2) = tmp_vectors(1,3)*tmp_vectors(2,1) - tmp_vectors(1,1)*tmp_vectors(2,3)
              perpendicular_vec(3) = tmp_vectors(1,1)*tmp_vectors(2,2) - tmp_vectors(1,2)*tmp_vectors(2,1)
              exit loop2
            end if
          end do loop2
          !
          ! normalize vector
          !
          perpendicular_vec(:) = perpendicular_vec(:)/sqrt(sum(perpendicular_vec(:)**2))
          ! 
          ! assign center for FOD generation
          !
          if (lone_fods(a,1) > 0) then
            f = pos1_up(a)%n_shells
            g = pos1_up(a)%n_points(f)-lone_fods(a,1)+1                                                      ! outermost shell -> get radius of that shell
            bond_center(:) = pos1_up(a)%center_x_y_z(:) + &
            & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*perpendicular_vec(:)*pos1_up(a)%r_theta_phi(f,g,1)   ! UP channel
            if ((lone_fods(a,1) == 1) .and. (lone_fods(a,2) == 0)) then                                      ! in case there is only exactly one lone FODs (none in the other spin channel)
              bond_center(:) = pos1_up(a)%center_x_y_z(:) + perpendicular_vec(:)*pos1_up(a)%r_theta_phi(f,g,1)
            end if
          else if (lone_fods(a,2) > 0) then
            f = pos1_dn(a)%n_shells
            g = pos1_dn(a)%n_points(f)-lone_fods(a,2)+1
            bond_center(:) = pos1_dn(a)%center_x_y_z(:) + &
            & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*perpendicular_vec(:)*pos1_dn(a)%r_theta_phi(f,g,1)   ! DN
            if ((lone_fods(a,1) == 0) .and. (lone_fods(a,2) == 1)) then                                      ! in case there is only exactly one lone FODs (none in the other spin channel)
              bond_center(:) = pos1_up(a)%center_x_y_z(:) + perpendicular_vec(:)*pos1_dn(a)%r_theta_phi(f,g,1)
            end if
          end if
          deallocate(tmp_vectors)
        !
        ! Neither linear nor planar
        !
        else                                                                                                 ! if less than one bonding partner -> just initialize 'normally'
          ! 
          ! assign center for FOD generation
          !
          bond_vector(:) = bond_vector(:)/sqrt(sum(bond_vector(:)**2))                                       ! normalize bond vector
          if (lone_fods(a,1) > 0) then
            f = pos1_up(a)%n_shells
            g = pos1_up(a)%n_points(f)-lone_fods(a,1)+1                                                      ! outermost shell -> get radius of that shell
            bond_center(:) = pos1_up(a)%center_x_y_z(:) + &
            & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*bond_vector(:)*pos1_up(a)%r_theta_phi(f,g,1)         ! UP Scale to number of lone FODs -> bring multiple lone_FODs closer to the atoms
          else if (lone_fods(a,2) > 0) then
            f = pos1_dn(a)%n_shells
            g = pos1_dn(a)%n_points(f)-lone_fods(a,2)+1
            bond_center(:) = pos1_up(a)%center_x_y_z(:) + &
            & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*bond_vector(:)*pos1_dn(a)%r_theta_phi(f,g,1)         ! DN
          end if
        end if

        !!!!!!!!!!!!!!!!!!!!
        ! SINGLE LONE FODs !
        !!!!!!!!!!!!!!!!!!!!
        if (lone_fods(a,1) == 1) then                                                                        ! UP lone FOD
          b = pos1_up(a)%n_shells                                                                            ! valence shell
          c = pos1_up(a)%n_points(b)-lone_fods(a,1)+1                                                        ! Only one point to place
          pos1_up(a)%point_x_y_z(b,c,:) = bond_center(:)
        end if
        if (lone_fods(a,2) == 1) then                                                                        ! DN lone FOD
          b = pos1_dn(a)%n_shells                                                                            ! valence shell
          c = pos1_dn(a)%n_points(b)-lone_fods(a,2)+1                                                        ! Only one point to place
          pos1_dn(a)%point_x_y_z(b,c,:) = bond_center(:)
        end if
        !
        ! OVERWRITE ANY EXISTING pos2 -> currently necessary for next optimization
        ! KT: is this still true? It doesn't really matter, but might be good to check
        !
        do b = 1, pos1_up(a)%n_shells                                                                        ! UP CHANNEL
          do c = 1, pos1_up(a)%n_points(b)
            pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
          end do
        end do
        do b = 1, pos1_dn(a)%n_shells                                                                        ! DN CHANNEL
          do c = 1, pos1_dn(a)%n_points(b)
            pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
          end do
        end do

        !!!!!!!!!!!!!!!!!!!!!!
        ! MULTIPLE LONE FODs !
        !!!!!!!!!!!!!!!!!!!!!!
        ! Take perpendicular vector to the bond vector -> is perpendicular to the bond axis
        ! Use this vector (and a given radius) to place FODs perpendicular to the bond (vector applied to the lone-FOD center!)
        ! Rotate these points around the bond vector via MC to minimize their 1/r contribution
        ! NEW: symmetrize with respect to bond FODs around if possible, i.e., if number of bond FODs matches the number of lone FODs
        !
        ! find a vector which is perpendicular to the bond vector
        !
        call per_vector(bond_vector(:),pos1_up(a)%center_x_y_z(:),perpendicular_vec(:))

!!!!!!!!!!!!!!
! UP CHANNEL !
!!!!!!!!!!!!!!
        if (lone_fods(a,1) > 1) then                                                                                   ! UP CHANNEL
          b = pos1_up(a)%n_shells                                                                                      ! valence shell UP
          d = 0
          do c = pos1_up(a)%n_points(b)-lone_fods(a,1)+1, pos1_up(a)%n_points(b)                                       ! UP FODs which are not in a bond, but are LONE -> only consider these FODs
            d = d + 1
            ! 
            ! get lone FODs via structural motifs
            ! Rotate them into bond_vector to have them perpendicular to the bond axis
            ! Use different structual motifs than for core FODs, which will be different from 4 points on
            ! Get perpendicular vector corresponding to the structural motif -> use this to rotate the motif perpendicular to 
            ! the bond axis 
            !
            call struct_motif_bond_lone(lone_fods(a,1),d,pos1_up(a)%r_theta_phi(b,c,1)*scale_r, &
                                        bond_center,pos1_up(a)%point_x_y_z(b,c,:),perpendicular_vec_motif)
          end do
          !
          ! Rotate the perpendicular vector of the structural motif into the bond_vector -> perpendicular to the bond axis
          ! Get rotation matrix
          !
          call create_rotMat_vec1_into_vec2(full_rot,perpendicular_vec_motif,bond_vector)
          !
          ! Rotate all points
          !
          do c = pos1_up(a)%n_points(b)-lone_fods(a,1)+1, pos1_up(a)%n_points(b)
            call rotate_pos(full_rot,pos1_up(a)%point_x_y_z(b,c,:),&
                         bond_center,pos2_up(a)%point_x_y_z(b,c,:))
            pos1_up(a)%point_x_y_z(b,c,:) = pos2_up(a)%point_x_y_z(b,c,:)                                                ! restore the pos1 array
          end do
          !!!!!!!
          ! If there are two bonds to an atoms AND it is planar (like H2O)
          ! Place lone FODs perpendicular to that plane !
          !!!!!!!
          if ((is_planar_linear(a)==1).and.(counter==2).and.(lone_fods(a,1)==2)) then ! for exactly two bonds, two lone FODs and a planar situation
            ! 
            ! get cross product of two vectors to adjacent atoms -> cross product will give a perpendicular vector
            ! 
            allocate(tmp_vectors(2,3))
            tmp_vectors(1,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
            tmp_vectors(2,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
            counter = 0
            do c = 1, size(pos1_up)                                                                            ! for each other atom!
              if (con_mat(a,c) /= 0) then                                                                      ! if there is a UP-bond between atom a and atom b -> get bond vector
!!!                if (a < c) then                                                                                ! If it is an UP-FOD
                counter = counter + 1
                tmp_vectors(counter,:) = (pos1_up(a)%center_x_y_z(:) - pos1_up(c)%center_x_y_z(:))
!!!                end if
              end if
            end do
            !
            ! create normal vector. Cross product -> Perpendicular vector
            !
            perpendicular_vec(1) = tmp_vectors(1,2)*tmp_vectors(2,3) - tmp_vectors(1,3)*tmp_vectors(2,2)
            perpendicular_vec(2) = tmp_vectors(1,3)*tmp_vectors(2,1) - tmp_vectors(1,1)*tmp_vectors(2,3)
            perpendicular_vec(3) = tmp_vectors(1,1)*tmp_vectors(2,2) - tmp_vectors(1,2)*tmp_vectors(2,1)
            !
            ! normalize vector
            !
            perpendicular_vec(:) = perpendicular_vec(:)/sqrt(sum(perpendicular_vec(:)**2))
            ! 
            ! assign FOD positions. 
            !
            do c = pos1_up(a)%n_points(b)-lone_fods(a,1)+1, pos1_up(a)%n_points(b)
              if (c==pos1_up(a)%n_points(b)) then
                pos1_up(a)%point_x_y_z(b,c,:) = bond_center(:) + &
                & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*perpendicular_vec(:)*pos1_up(a)%r_theta_phi(b,c,1)
              else
                pos1_up(a)%point_x_y_z(b,c,:) = bond_center(:) - &
                & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*perpendicular_vec(:)*pos1_up(a)%r_theta_phi(b,c,1)
              end if
            end do
            deallocate(tmp_vectors)
          
          ! For any other situation
          else            
            !
            ! Rotate the point around the bond vector (bond axis).
            !
            ave_dist1_up = 100000.0
            do j = 1, cycles
              !
              ! Get a rotation matrix around the bond axis
              ! Use one rotation matrix for ALL points -> keep symmetry
              !
              call create_rotMat_bond(full_rot,bond_vector,step_size)
              !
              ! Rotate
              !
              g = pos1_up(a)%n_shells
              do c = pos1_up(a)%n_points(g)-lone_fods(a,1)+1, pos1_up(a)%n_points(g)
                if (is_planar_linear(a) == 0) then                                                      ! Not planar/linear. Rotate around bond_center
                  call rotate_pos(full_rot, pos1_up(a)%point_x_y_z(g,c,:), bond_center, &
                                            pos2_up(a)%point_x_y_z(g,c,:))
                else                                                                                    ! planar/linear -> rotate around atom
                  call rotate_pos(full_rot, pos1_up(a)%point_x_y_z(g,c,:), pos1_up(a)%center_x_y_z, &
                                            pos2_up(a)%point_x_y_z(g,c,:))
                end if
              end do
              !
              ! EVAL UP
              ! 1/r calculation. UP. Lone FODs against the rest
              ! valence contributions only.
              ! Use pos2 for the FOD positions, not pos1!
              !
              ave_dist2_up = 0.0
              g = pos1_up(a)%n_shells
              do c = pos1_up(a)%n_points(g)-lone_fods(a,1)+1, pos1_up(a)%n_points(g)
                do d = 1, size(pos1_up)                                                                  ! for all atoms
                  if ((con_mat(a,d) /= 0) .or. (con_mat(d,a) /= 0) .or. (a == d)) then                   ! only evaluate 1/r for neighbouring atoms -> all which have a bond to the atom under observation. 
                                                                                                         ! and for the same atom too
                    e = pos1_up(d)%n_shells
                    do f = 1, pos1_up(d)%n_points(e)
                      if ((a == d) .and. (b == e) .and. (c == f)) then                                   ! exclude evaluation of a point with itself
                        continue
                      else
                        ! HERE: periodicity?
                        ave_dist2_up = ave_dist2_up + &
                           1.0D0/sqrt(sum((pos2_up(a)%point_x_y_z(g,c,:) - pos1_up(d)%point_x_y_z(e,f,:))**2))
                      end if
                    end do
                  end if
                end do
              end do
              !
              ! Keep configuration?
              !
              if (ave_dist2_up < ave_dist1_up) then
                do c = pos1_up(a)%n_points(g)-lone_fods(a,1)+1, pos1_up(a)%n_points(g)
                  pos1_up(a)%point_x_y_z(g,c,:) = pos2_up(a)%point_x_y_z(g,c,:)
                end do
                ave_dist1_up = ave_dist2_up
              end if
            end do  

          end if    ! end planar & 2 bonds
          !
          ! If same number of UP and DN FODs in the lone pair -> just pair them right here (regarding the respective other atoms!)
          ! it is ugly right now, but it works
          !
          if (lone_fods(a,1) == lone_fods(a,2)) then
            b = pos1_up(a)%n_shells
            g = pos1_dn(a)%n_shells
            do h = 1, lone_fods(a,1)
              c = pos1_up(a)%n_points(b) - (h-1)
              i = pos1_dn(a)%n_points(b) - (h-1)
              pos1_dn(a)%point_x_y_z(g,i,:) = pos1_up(a)%point_x_y_z(b,c,:)
            end do
          end if
        end if


!!!!!!!!!!!!!!
! DN CHANNEL !
!!!!!!!!!!!!!!
        if (lone_fods(a,2) > 1) then                                                                                   ! DN CHANNEL
          if (lone_fods(a,1) == lone_fods(a,2)) then                                                                   ! same number of UP and DN lone FODs -> nothing to do (already paired)
            continue
          else
            b = pos1_dn(a)%n_shells                                                                                      ! valence shell DN
            d = 0
            do c = pos1_dn(a)%n_points(b)-lone_fods(a,2)+1, pos1_dn(a)%n_points(b)                                       ! DN FODs which are not in a bond, but are LONE -> only consider these FODs
              d = d + 1
              ! 
              ! get lone FODs via structural motifs
              ! Rotate them into bond_vector to have them perpendicular to the bond axis
              ! Use different structual motifs than for core FODs, which will be different from 4 points on
              ! Get perpendicular vector corresponding to the structural motif -> use this to rotate the motif perpendicular to 
              ! the bond axis 
              !
              call struct_motif_bond_lone(lone_fods(a,2),d,pos1_dn(a)%r_theta_phi(b,c,1)*scale_r, &
                                          bond_center,pos1_dn(a)%point_x_y_z(b,c,:),perpendicular_vec_motif)
            end do
            !
            ! Rotate the perpendicular vector of the structural motif into the bond_vector -> perpendicular to the bond axis
            ! Get rotation matrix
            !
            call create_rotMat_vec1_into_vec2(full_rot,perpendicular_vec_motif,bond_vector)
            !
            ! Rotate all points
            !
            do c = pos1_dn(a)%n_points(b)-lone_fods(a,2)+1, pos1_dn(a)%n_points(b)
              call rotate_pos(full_rot,pos1_dn(a)%point_x_y_z(b,c,:),&
                           bond_center,pos2_dn(a)%point_x_y_z(b,c,:))
              pos1_dn(a)%point_x_y_z(b,c,:) = pos2_dn(a)%point_x_y_z(b,c,:)                                                ! restore the pos1 array
            end do
            !!!!!!!
            ! If there are two bonds to an atoms AND it is planar (like H2O)
            ! Place lone FODs perpendicular to that plane !
            !!!!!!!
            if ((is_planar_linear(a)==1).and.(counter==2).and.(lone_fods(a,2)==2)) then ! for exactly two bonds, two lone FODs and a planar situation
              ! 
              ! get cross product of two vectors to adjacent atoms -> cross product will give a perpendicular vector
              ! 
              allocate(tmp_vectors(2,size(pos1_dn)))
              tmp_vectors(1,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
              tmp_vectors(2,:) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)
              counter = 0
              do c = 1, size(pos1_dn)                                                                            ! for each other atom!
                if (con_mat(a,c) /= 0) then                                                                      ! if there is a DN-bond between atom a and atom c -> get bond vector
                  if (a > c) then                                                                                ! If it is an DN-FOD
                    counter = counter + 1
                    tmp_vectors(counter,:) = (pos1_dn(a)%center_x_y_z(:) - pos1_dn(c)%center_x_y_z(:))
                  end if
                end if
              end do
              !
              ! create normal vector. Cross product -> Perpendicular vector
              !
              perpendicular_vec(1) = tmp_vectors(1,2)*tmp_vectors(2,3) - tmp_vectors(1,3)*tmp_vectors(2,2)
              perpendicular_vec(2) = tmp_vectors(1,3)*tmp_vectors(2,1) - tmp_vectors(1,1)*tmp_vectors(2,3)
              perpendicular_vec(3) = tmp_vectors(1,1)*tmp_vectors(2,2) - tmp_vectors(1,2)*tmp_vectors(2,1)
              !
              ! normalize vector
              !
              perpendicular_vec(:) = perpendicular_vec(:)/sqrt(sum(perpendicular_vec(:)**2))
              ! 
              ! assign FOD positions. 
              !
              do c = pos1_dn(a)%n_points(b)-lone_fods(a,2)+1, pos1_dn(a)%n_points(b)
                if (c==pos1_dn(a)%n_points(b)) then
                  pos1_dn(a)%point_x_y_z(b,c,:) = bond_center(:) + &
                  & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*perpendicular_vec(:)*pos1_dn(a)%r_theta_phi(b,c,1)
                else
                  pos1_dn(a)%point_x_y_z(b,c,:) = bond_center(:) - &
                  & 1.0D0/((lone_fods(a,1)+lone_fods(a,2))/2.0D0)*perpendicular_vec(:)*pos1_dn(a)%r_theta_phi(b,c,1)
                end if
              end do
              deallocate(tmp_vectors)
           
            ! For any other situation
            else
              !
              ! Rotate the point around the bond vector (bond axis).
              !
              ave_dist1_dn = 100000.0
              do j = 1, cycles
                !
                ! Get a rotation matrix around the bond axis
                ! Use one rotation matrix for ALL points -> keep symmetry
                !
                call create_rotMat_bond(full_rot,bond_vector,step_size)
                !
                ! Rotate
                !
                g = pos1_dn(a)%n_shells
                do c = pos1_dn(a)%n_points(g)-lone_fods(a,2)+1, pos1_dn(a)%n_points(g)
                  if (is_planar_linear(a) == 0) then                                                      ! Not planar/linear. Rotate around bond_center
                    call rotate_pos(full_rot, pos1_dn(a)%point_x_y_z(g,c,:), bond_center, &
                                              pos2_dn(a)%point_x_y_z(g,c,:))
                  else                                                                                    ! planar/linear -> rotate around atom
                    call rotate_pos(full_rot, pos1_dn(a)%point_x_y_z(g,c,:), pos1_dn(a)%center_x_y_z, &
                                              pos2_dn(a)%point_x_y_z(g,c,:))
                  end if
                end do
                !
                ! EVAL DN
                ! 1/r calculation. DN. Lone FODs against the rest
                ! valence contributions only.
                ! Use pos2 for the FOD positions, not pos1!
                !
                ave_dist2_dn = 0.0
                g = pos1_dn(a)%n_shells
                do c = pos1_dn(a)%n_points(g)-lone_fods(a,2)+1, pos1_dn(a)%n_points(g)
                  do d = 1, size(pos1_up)                                                                  ! for all atoms
                    if ((con_mat(a,d) /= 0) .or. (con_mat(d,a) /= 0) .or. (a == d)) then                   ! only evaluate 1/r for neighbouring atoms -> all which have a bond to the atom under observation. 
                                                                                                           ! and for the same atom too
                      e = pos1_dn(d)%n_shells
                      do f = 1, pos1_dn(d)%n_points(e)
                        if ((a == d) .and. (b == e) .and. (c == f)) then                                   ! exclude evaluation of a point with itself
                          continue
                        else
                          ! HERE: periodicity?
                          ave_dist2_dn = ave_dist2_dn + &
                             1.0D0/sqrt(sum((pos2_dn(a)%point_x_y_z(g,c,:) - pos1_dn(d)%point_x_y_z(e,f,:))**2))
                        end if
                      end do
                    end if
                  end do
                end do
                !
                ! Keep configuration?
                !
                if (ave_dist2_dn < ave_dist1_dn) then
                  do c = pos1_dn(a)%n_points(g)-lone_fods(a,2)+1, pos1_dn(a)%n_points(g)
                    pos1_dn(a)%point_x_y_z(g,c,:) = pos2_dn(a)%point_x_y_z(g,c,:)
                  end do
                  ave_dist1_dn = ave_dist2_dn
                end if
                          

              end do
            end if
          end if
        end if 
      end if 
    end if
  end do


!
! OVERWRITE ANY EXISTING pos2 -> currently necessary for next optimization
!
  do a = 1, size(pos1_up)                                                      ! for each atom!
    do b = 1, pos1_up(a)%n_shells                                              ! UP CHANNEL
      do c = 1, pos1_up(a)%n_points(b)
        pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
      end do
    end do
  end do
  do a = 1, size(pos1_dn)                                                      ! for each atom!
    do b = 1, pos1_dn(a)%n_shells                                              ! DN CHANNEL
      do c = 1, pos1_dn(a)%n_points(b)
        pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
      end do
    end do
  end do



!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! CREATE CORE FODs. Minimize 1/r for core  !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 
  do a = 1, size(pos1_up)                                                      ! for each atom!

! NEW Use structural motifs
    !
    ! Get UP CHANNEL  
    !
    do b = 1, pos1_up(a)%n_shells-1                                            ! Only core
      do c = 1, pos1_up(a)%n_points(b)
        call struct_motif(pos1_up(a)%n_points(b),c,pos1_up(a)%r_theta_phi(b,c,1),&
                          pos1_up(a)%center_x_y_z(1:3),pos1_up(a)%point_x_y_z(b,c,1:3))
        pos2_up(a)%point_x_y_z(b,c,1:3) = pos1_up(a)%point_x_y_z(b,c,1:3)
      end do
      !
      ! Optimize core structure globally (via rotations) with respect to any smaller shell
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! ROTATIONS                                              !
      ! Rotate current core against any lower core. UP Channel !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      if ((b > 1) .and. (b <= pos1_up(a)%n_shells-1)) then                           ! any shell except the 1s. 
        ave_dist1_up = 100000000.0
        do t = 1, cycles
          call create_rotMat(full_rot, step_size)                                    ! generates a random rotation matrix
          do c = 1, pos1_up(a)%n_points(b)
            call rotate_pos(full_rot, pos1_up(a)%point_x_y_z(b,c,1:3), &
                            pos1_up(a)%center_x_y_z(1:3), pos2_up(a)%point_x_y_z(b,c,1:3))
          end do
          !
          ! 1/r calculation
          !
          ave_dist2_up = 0.0                                                         ! 1/r UP
          do c = 1, pos2_up(a)%n_points(b)
            do d = 1, b-1                                                            ! Use any smaller shell structure and optimize the higher shell according to the lower core structure
              do f = 1, pos1_up(a)%n_points(d)                                       ! Unchanged index, thus index 1
                ave_dist2_up  = ave_dist2_up + &
                       1.0D0/sqrt(sum((pos2_up(a)%point_x_y_z(b,c,:) - pos1_up(a)%point_x_y_z(d,f,:))**2))
              end do
            end do
          end do
          !
          ! Use Metropolis-like algorithm. Allow f_r to go uphill for the rotations!
          ! How: ... Introduce random number rand_metro [0,1]
          !          if (ave_dist2_up < ave_dist1_up) -> take new config
          !          if (ave_dist2_up > ave_dist1_up) -> if (ave_dist2_up-ave_dist1_up) < rand_metro*step_size => still take new config. Else: Take old config.
          !          ==>> If new 1/r is only slighlty larger AND rand_metro*step_size is small enough
          if (ave_dist2_up < ave_dist1_up) then
            pos1_up(a)%point_x_y_z(:,:,:) = pos2_up(a)%point_x_y_z(:,:,:)
            pos1_up(a)%r_theta_phi(:,:,:) = pos2_up(a)%r_theta_phi(:,:,:)
            ave_dist1_up = ave_dist2_up
          else
            call random_number(rand_metro)
            if ((ave_dist2_up-ave_dist1_up) < rand_metro*step_size*0.01) then
              pos1_up(a)%point_x_y_z(:,:,:) = pos2_up(a)%point_x_y_z(:,:,:)
              pos1_up(a)%r_theta_phi(:,:,:) = pos2_up(a)%r_theta_phi(:,:,:)
              ave_dist1_up = ave_dist2_up
            end if
          end if
        end do  ! end MC cycles
      end if    ! end if - shells
    end do      ! end UP channel
    ! 
    ! Further, rotate all cores with respect to the valence pattern!
    !
    ave_dist1_up = 100000000.0
    do t = 1, cycles
      call create_rotMat(full_rot, step_size)                                    ! generates a random rotation matrix
      do b = 1, pos1_up(a)%n_shells-1 
        do c = 1, pos1_up(a)%n_points(b)
          call rotate_pos(full_rot, pos1_up(a)%point_x_y_z(b,c,1:3), &
                          pos1_up(a)%center_x_y_z(1:3), pos2_up(a)%point_x_y_z(b,c,1:3))
        end do
      end do
      !
      ! 1/r calculation
      !
      ave_dist2_up = 0.0                                                         ! 1/r UP
      do b = 1, pos2_up(a)%n_shells-1
        do c = 1, pos2_up(a)%n_points(b)
          do g = 1, size(pos1_up)                                                ! for all atoms 
            d = pos1_up(g)%n_shells                                                ! Outermost fods
            do f = 1, pos1_up(g)%n_points(d)                                       ! 
              ave_dist2_up  = ave_dist2_up + &
                     1.0D0/sqrt(sum((pos2_up(a)%point_x_y_z(b,c,:) - pos1_up(g)%point_x_y_z(d,f,:))**2))
            end do
          end do
        end do
      end do
      !
      ! Use Metropolis-like algorithm. Allow f_r to go uphill for the rotations!
      ! How: ... Introduce random number rand_metro [0,1]
      !          if (ave_dist2_up < ave_dist1_up) -> take new config
      !          if (ave_dist2_up > ave_dist1_up) -> if (ave_dist2_up-ave_dist1_up) < rand_metro*step_size => still take new config. Else: Take old config.
      !          ==>> If new 1/r is only slighlty larger AND rand_metro*step_size is small enough
      if (ave_dist2_up < ave_dist1_up) then
        pos1_up(a)%point_x_y_z(:,:,:) = pos2_up(a)%point_x_y_z(:,:,:)
        pos1_up(a)%r_theta_phi(:,:,:) = pos2_up(a)%r_theta_phi(:,:,:)
        ave_dist1_up = ave_dist2_up
      else
        call random_number(rand_metro)
        if ((ave_dist2_up-ave_dist1_up) < rand_metro*step_size*0.01) then
          pos1_up(a)%point_x_y_z(:,:,:) = pos2_up(a)%point_x_y_z(:,:,:)
          pos1_up(a)%r_theta_phi(:,:,:) = pos2_up(a)%r_theta_phi(:,:,:)
          ave_dist1_up = ave_dist2_up
        end if
      end if
    end do    ! end MC cycle. final end UP channels


    !
    ! Get DN CHANNEL  
    !
    do b = 1, pos1_dn(a)%n_shells-1                                            ! Only core
      do c = 1, pos1_dn(a)%n_points(b)
        call struct_motif(pos1_dn(a)%n_points(b),c,pos1_dn(a)%r_theta_phi(b,c,1),&
                          pos1_dn(a)%center_x_y_z(1:3),pos1_dn(a)%point_x_y_z(b,c,1:3))
        pos2_dn(a)%point_x_y_z(b,c,1:3) = pos1_dn(a)%point_x_y_z(b,c,1:3)
      end do
      !
      ! Optimize core structure globally (via rotations) with respect to any smaller shell
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! ROTATIONS                                              !
      ! Rotate current core against any lower core. DN Channel !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      if ((b > 1) .and. (b <= pos1_dn(a)%n_shells-1)) then                           ! any shell except the 1s. 
        ave_dist1_dn = 100000000.0
        do t = 1, cycles
          call create_rotMat(full_rot, step_size)                                    ! generates a random rotation matrix
          do c = 1, pos1_dn(a)%n_points(b)
            call rotate_pos(full_rot, pos1_dn(a)%point_x_y_z(b,c,1:3), &
                            pos1_dn(a)%center_x_y_z(1:3), pos2_dn(a)%point_x_y_z(b,c,1:3))
          end do
          !
          ! 1/r calculation
          !
          ave_dist2_dn = 0.0                                                         ! 1/r DN
          do c = 1, pos2_dn(a)%n_points(b)
            do d = 1, b-1                                                            ! Use any smaller shell structure and optimize the higher shell according to the lower core structure
              do f = 1, pos1_dn(a)%n_points(d)                                       ! Unchanged index, thus index 1
                ave_dist2_dn  = ave_dist2_dn + &
                       1.0D0/sqrt(sum((pos2_dn(a)%point_x_y_z(b,c,:) - pos1_dn(a)%point_x_y_z(d,f,:))**2))
              end do
            end do
          end do
          !
          ! Use Metropolis-like algorithm. Allow f_r to go uphill for the rotations!
          ! How: ... Introduce random number rand_metro [0,1]
          !          if (ave_dist2_dn < ave_dist1_dn) -> take new config
          !          if (ave_dist2_dn > ave_dist1_dn) -> if (ave_dist2_dn-ave_dist1_dn) < rand_metro*step_size => still take new config. Else: Take old config.
          !          ==>> If new 1/r is only slighlty larger AND rand_metro*step_size is small enough
          if (ave_dist2_dn < ave_dist1_dn) then
            pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
            pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
            ave_dist1_dn = ave_dist2_dn
          else
            call random_number(rand_metro)
            if ((ave_dist2_dn-ave_dist1_dn) < rand_metro*step_size*0.01) then
              pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
              pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
              ave_dist1_dn = ave_dist2_dn
            end if
          end if
        end do  ! end MC cycles
      end if
    end do
    ! 
    ! Further, rotate all cores with respect to the valence pattern!
    !
    ave_dist1_dn = 100000000.0
    do t = 1, cycles
      call create_rotMat(full_rot, step_size)                                    ! generates a random rotation matrix
      do b = 1, pos1_dn(a)%n_shells-1
        do c = 1, pos1_dn(a)%n_points(b)
          call rotate_pos(full_rot, pos1_dn(a)%point_x_y_z(b,c,1:3), &
                          pos1_dn(a)%center_x_y_z(1:3), pos2_dn(a)%point_x_y_z(b,c,1:3))
        end do
      end do
      !
      ! 1/r calculation
      !
      ave_dist2_dn = 0.0                                                         ! 1/r UP
      do b = 1, pos2_dn(a)%n_shells-1
        do c = 1, pos2_dn(a)%n_points(b)
          do g = 1, size(pos1_dn)                                                ! for all atoms 
            d = pos1_dn(g)%n_shells                                                ! Outermost fods
            do f = 1, pos1_dn(g)%n_points(d)                                       ! 
              ave_dist2_dn  = ave_dist2_dn + &
                      1.0D0/sqrt(sum((pos2_dn(a)%point_x_y_z(b,c,:) - pos1_dn(g)%point_x_y_z(d,f,:))**2))
            end do
          end do
        end do
      end do
      !
      ! Use Metropolis-like algorithm. Allow f_r to go uphill for the rotations!
      ! How: ... Introduce random number rand_metro [0,1]
      !          if (ave_dist2_up < ave_dist1_up) -> take new config
      !          if (ave_dist2_up > ave_dist1_up) -> if (ave_dist2_up-ave_dist1_up) < rand_metro*step_size => still take new config. Else: Take old config.
      !          ==>> If new 1/r is only slighlty larger AND rand_metro*step_size is small enough
      if (ave_dist2_dn < ave_dist1_dn) then
        pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
        pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
        ave_dist1_dn = ave_dist2_dn
      else
        call random_number(rand_metro)
        if ((ave_dist2_dn-ave_dist1_dn) < rand_metro*step_size*0.01) then
          pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
          pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
          ave_dist1_dn = ave_dist2_dn
        end if
      end if
    end do    ! end MC cycle. final end DN channel
  end do
! END NEW

! For molecules -> not rotation of DN vs UP in the end. Shouldn't be necessary
! Or maybe it is, for Linnett cores !


! Sep. 4, 2020
! KT: HERE rotate DN vs UP. Either align them (Lewis) or counter-align them (Linnett)
!     We could make this a general idea, for bonds and lone as well
! For same number of UP and DN: Either put ontop of each other, or inverted ?
!    Use UP or DN, depending on which has a lower ave_dist1
! Else: use MC (TBD)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!! Treat alignment of UP vs. DN. Core FODs !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!  do a = 1, size(pos1_up)                                                      ! for each atom!
!!!    !
!!!    ! Go through UP and DN channel  
!!!    !
!!!    do b = 1, pos1_up(a)%n_shells-1                                            ! Only core
!!!      do d = 1, pos1_dn(a)%n_shells-1                                          ! Only core
!!!        ! Only compare same shells
!!!        if (b == d) then
!!!          if (pos1_up(a)%n_points(b) == pos1_dn(a)%n_points(d)) then
!!!            ! LEWIS. Put then at the same position
!!!            ! If DN has lower Coulomb repulsion -> put UP to DN
!!!            if (ave_dist1_dn < ave_dist1_up) then
!!!              do c = 1, pos1_dn(a)%n_points(d)
!!!                pos1_up(a)%point_x_y_z(b,c,:) = pos1_dn(a)%point_x_y_z(d,c,:)
!!!              end do
!!!            ! If UP has lower Coulomb repuslion -> put DN to UP
!!!            else
!!!              do c = 1, pos1_up(a)%n_points(b)
!!!                pos1_dn(a)%point_x_y_z(d,c,:) = pos1_up(a)%point_x_y_z(b,c,:)
!!!              end do
!!!            end if
!!!
!!!!!!            ! LINNETT. Invert UP and DN.
!!!!!!            ! If DN has lower Coulomb repulsion -> put UP inverted from DN
!!!!!!            ! Respect the position of the of the corresponding atom
!!!!!!            if (ave_dist1_dn < ave_dist1_up) then
!!!!!!              do c = 1, pos1_dn(a)%n_points(d)
!!!!!!                pos1_up(a)%point_x_y_z(b,c,:) = 2.0D0*pos1_up(a)%center_x_y_z(:) - pos1_dn(a)%point_x_y_z(d,c,:)
!!!!!!              end do
!!!!!!            ! If UP has lower Coulomb repuslion -> put DN to UP
!!!!!!            else    
!!!!!!              do c = 1, pos1_up(a)%n_points(b)
!!!!!!                pos1_dn(a)%point_x_y_z(d,c,:) = 2.0D0*pos1_up(a)%center_x_y_z(:) - pos1_up(a)%point_x_y_z(b,c,:)
!!!!!!              end do
!!!!!!            end if
!!!
!!!          end if
!!!        end if
!!!      end do
!!!    end do
!!!  end do

!!!!
!!!!
!!!!
!!!!
!!!!
!!!!
!!!!      !
!!!!      ave_dist2_dn_core = 0.0
!!!!      do b = 1, pos2_dn(a)%n_shells-1
!!!!        do c = 1, pos2_dn(a)%n_points(b)
!!!!          do d = 1, size(pos1_dn)
!!!!            do e = 1, pos2_dn(d)%n_shells
!!!!              do f = 1, pos2_dn(d)%n_points(e)
!!!!                if ((a == d) .and. (b == e) .and. (c == f)) then               ! do not evaluate 1/r for one and the same point
!!!!                else
!!!!                   ave_dist2_dn_core = ave_dist2_dn_core + &
!!!!                           1.0/sqrt(sum((pos2_dn(a)%point_x_y_z(b,c,:) - pos2_dn(d)%point_x_y_z(e,f,:))**2))
!!!!                end if
!!!!              end do
!!!!            end do
!!!!          end do
!!!!        end do
!!!!      end do
!!!!! HERE: NEW use Metropolis algorithm. Allow f_r to go uphill for the rotations!
!!!!! How: ... Introduce random number rand_metro [0,1]
!!!!!          if (ave_dist2_up < ave_dist1_up) -> take new config
!!!!!          if (ave_dist2_up > ave_dist1_up) -> if (ave_dist2_up-ave_dist1_up) < rand_metro*0.01 => still take new config. Else: Take old config.
!!!!!          ==>> If new 1/r is only slighlty larger AND rand_metro*0.01 is small enough
!!!!      if (ave_dist2_dn_core < ave_dist1_dn_core) then
!!!!        pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
!!!!        pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
!!!!        ave_dist1_dn_core = ave_dist2_dn_core
!!!!      else
!!!!        call random_number(rand_metro)
!!!!        if ((ave_dist2_dn_core-ave_dist1_dn_core) < rand_metro*step_size) then
!!!!          pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
!!!!          pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
!!!!          ave_dist1_dn_core = ave_dist2_dn_core
!!!!        end if
!!!!      end if
!!!!!!!      !
!!!!!!!      ! Keep configuration?
!!!!!!!      !
!!!!!!!      if (ave_dist2_dn_core < ave_dist1_dn_core) then                          ! < if minimizing 1/r, > if maximizing 1/r
!!!!!!!        pos1_dn(a)%point_x_y_z(:,:,:) = pos2_dn(a)%point_x_y_z(:,:,:)
!!!!!!!        pos1_dn(a)%r_theta_phi(:,:,:) = pos2_dn(a)%r_theta_phi(:,:,:)
!!!!!!!        ave_dist1_dn_core = ave_dist2_dn_core
!!!!!!!      end if
!!!!    end do                                                                     ! end MC cycles for core optimization
!!!!  end do                                                                       ! end atoms

!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!
!! END OF fodMC !!
!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!

! Point charge dipole evaluation !
! Sum r_{FODs}*(-1) - <r_{atoms}>
! Calculate with respect to the center of all atoms
! *-1 -> correct direction of dipole
!
  cent_x = 0.0D0
  cent_y = 0.0D0
  cent_z = 0.0D0
  do a = 1, size(pos1_up)
    cent_x = cent_x + pos1_up(a)%center_x_y_z(1)
    cent_y = cent_y + pos1_up(a)%center_x_y_z(2)
    cent_z = cent_z + pos1_up(a)%center_x_y_z(3)
  end do
  cent_x = cent_x/size(pos1_up)
  cent_y = cent_y/size(pos1_up)
  cent_z = cent_z/size(pos1_up)

  dip_x = 0.0D0                                                                   ! initialize with 0
  dip_y = 0.0D0
  dip_z = 0.0D0
  do a = 1, size(pos1_up)                                                       ! for all atoms
    do b = 1, pos1_up(a)%n_shells                                              ! and all UP-FODs
      do c = 1, pos1_up(a)%n_points(b)
        dip_x = dip_x - (pos1_up(a)%point_x_y_z(b,c,1) - cent_x)
        dip_y = dip_y - (pos1_up(a)%point_x_y_z(b,c,2) - cent_y)
        dip_z = dip_z - (pos1_up(a)%point_x_y_z(b,c,3) - cent_z)
      end do
    end do
    do b = 1, pos1_dn(a)%n_shells                                               ! all DN-FODs
      do c = 1, pos1_dn(a)%n_points(b)
        dip_x = dip_x - (pos1_dn(a)%point_x_y_z(b,c,1) - cent_x)
        dip_y = dip_y - (pos1_dn(a)%point_x_y_z(b,c,2) - cent_y)
        dip_z = dip_z - (pos1_dn(a)%point_x_y_z(b,c,3) - cent_z)
      end do
    end do
  end do
  !
  ! Charge and spin evaluated in the beginning of the molecular guess creation
  !
  write(6,fmt='(1X,A,F8.3,2X,A,F8.3,2X,A,3(F12.5,2X))') 'charge = ',charge,' spin = ',spin, &
                         & ' Point charge dipole ', dip_x, dip_y, dip_z
  write(6,*) ' '

  !
  ! Total time
  !
  call cpu_time(finish_t)
  write(6,*) 'Total CPU time was ',finish_t - start_t,'s'

  !
  ! If periodic system: Generate .cif file
  !
  if (periodic) then
    len_a = sqrt(cell_a(1)**2+cell_a(2)**2+cell_a(3)**2)
    len_b = sqrt(cell_b(1)**2+cell_b(2)**2+cell_b(3)**2)
    len_c = sqrt(cell_c(1)**2+cell_c(2)**2+cell_c(3)**2)
    angle_bc = ACOS((cell_b(1)*cell_c(1) + cell_b(2)*cell_c(2) + cell_b(3)*cell_c(3))/(len_b*len_c))*180.0D0/pi
    angle_ac = ACOS((cell_a(1)*cell_c(1) + cell_a(2)*cell_c(2) + cell_a(3)*cell_c(3))/(len_a*len_c))*180.0D0/pi
    angle_ab = ACOS((cell_a(1)*cell_b(1) + cell_a(2)*cell_b(2) + cell_a(3)*cell_b(3))/(len_a*len_b))*180.0D0/pi

    len_a = sqrt(cell_a(1)**2+cell_a(2)**2+cell_a(3)**2)*0.529177D0/units_factor ! always in angstrom
    len_b = sqrt(cell_b(1)**2+cell_b(2)**2+cell_b(3)**2)*0.529177D0/units_factor
    len_c = sqrt(cell_c(1)**2+cell_c(2)**2+cell_c(3)**2)*0.529177D0/units_factor

    open(unit=19,file='Nuc_FOD.cif',status='unknown',action='write')
    write(19,*) '# fodMC guess'
    write(19,*) ' '
    write(19,fmt='(A)') "_chemical_name_common                  'fodMC'"
    write(19,fmt='(A,F13.8)') "_cell_length_a                         ",len_a
    write(19,fmt='(A,F13.8)') "_cell_length_b                         ",len_b
    write(19,fmt='(A,F13.8)') "_cell_length_c                         ",len_c
    write(19,fmt='(A,F9.4)') "_cell_angle_alpha                      ",angle_bc
    write(19,fmt='(A,F9.4)') "_cell_angle_beta                       ",angle_ac
    write(19,fmt='(A,F9.4)') "_cell_angle_gamma                      ",angle_ab
    write(19,fmt='(A)') "_space_group_name_H-M_alt              'P 1'"
    write(19,fmt='(A)') "loop_"
    write(19,fmt='(A)') "   _atom_site_type_symbol"
    write(19,fmt='(A)') "   _atom_site_fract_x"
    write(19,fmt='(A)') "   _atom_site_fract_y"
    write(19,fmt='(A)') "   _atom_site_fract_z"
    do a = 1, size(pos1_up)
      call cart_to_frac(cell_a(1:3),cell_b(1:3),cell_c(1:3),pos1_up(a)%center_x_y_z(1:3),pos2_up(a)%center_x_y_z(1:3))
      if (pos1_up(a)%elements(2:2) == '_') then
        write(19,fmt='(A4,3X,3(F13.8,2X))') pos1_up(a)%elements(1:1),pos2_up(a)%center_x_y_z(1:3)
      else
        write(19,fmt='(A4,3X,3(F13.8,2X))') pos1_up(a)%elements(1:2),pos2_up(a)%center_x_y_z(1:3)
      end if
    end do
    do a = 1, size(pos1_up)
      do b = 1, pos1_up(a)%n_shells
        do c = 1, pos1_up(a)%n_points(b)
          call cart_to_frac(cell_a(1:3),cell_b(1:3),cell_c(1:3),pos1_up(a)%point_x_y_z(b,c,1:3),pos2_up(a)%point_x_y_z(b,c,1:3))
          write(19,fmt='(A3,4X,3(F13.8,2X))') 'X',pos2_up(a)%point_x_y_z(b,c,1:3)
        end do
      end do
    end do
    do a = 1, size(pos1_dn)
      do b = 1, pos1_dn(a)%n_shells
        do c = 1, pos1_dn(a)%n_points(b)
          call cart_to_frac(cell_a(1:3),cell_b(1:3),cell_c(1:3),pos1_dn(a)%point_x_y_z(b,c,1:3),pos2_dn(a)%point_x_y_z(b,c,1:3))
          write(19,fmt='(A4,3X,3(F13.8,2X))') 'He',pos2_dn(a)%point_x_y_z(b,c,1:3)
        end do
      end do
    end do
    close(unit=19)
  end if


  !
  ! GET GENERAL INFORMATION
  !
  charge     = 0.0
  spin       = 0.0
  counter_up = 0
  counter_dn = 0
  do a = 1, size(pos1_up)
    charge     = charge + real(element_number(a) - pseudo_charge(a) - & 
               & sum(pos1_up(a)%n_points(:)) - sum(pos1_dn(a)%n_points(:)),8)
    spin       = spin   + real(sum(pos1_up(a)%n_points(:)) - sum(pos1_dn(a)%n_points(:)),8)
    counter_up = counter_up + sum(pos1_up(a)%n_points(:))
    counter_dn = counter_dn + sum(pos1_dn(a)%n_points(:))
  end do

  !
  ! GENERATE CLUSTER AND FRMORB FILE for NRLMOL
  !
  if (output_mode == 'NRLMOL') then
    open(unit=19,file='CLUSTER',status='unknown',action='write')
    write(19,fmt='(A)') 'LDA-PW91*LDA-PW91            (DF TYPE EXCHANGE*CORRELATION)'
    write(19,fmt='(A)') 'NONE                         (TD, OH, IH, X, Y, XY, ... OR GRP)'
    write(19,fmt='(I3,A)') size(pos1_up),'                            (NUMBER OF ATOMS)'
    do a = 1, size(pos1_up)
      if ((pos1_up(a)%elements(3:5) == 'ECP') .or. (pos1_up(a)%elements(4:6) == 'ECP')) then
        write(19,fmt='(3(F13.8,2X),I3,1X,A)') pos1_up(a)%center_x_y_z(1:3)/units_factor, element_number(a), &
                                              & ' ECP (R, Z, Pseudopotential)'
      else
         write(19,fmt='(3(F13.8,2X),I3,1X,A)') pos1_up(a)%center_x_y_z(1:3)/units_factor, element_number(a), &
                                              & ' ALL (R, Z, ALL-ELECTRON)'
      end if
    end do
    write(19,fmt='(2(F6.3,2X),19X,A)') charge, spin, '(NET CHARGE AND NET SPIN)'
    close(unit=19)

    open(unit=19,file='FRMORB',status='unknown',action='write')
    write(19,fmt='(I3,5X,I3)') counter_up, counter_dn
    do a = 1, size(pos1_up)
      do b = 1, pos1_up(a)%n_shells
        do c = 1, pos1_up(a)%n_points(b)
          write(19,fmt='(3(F13.8,2X))') pos1_up(a)%point_x_y_z(b,c,1:3)/units_factor
        end do
      end do
    end do
    do a = 1, size(pos1_up)
      do b = 1, pos1_dn(a)%n_shells
        do c = 1, pos1_dn(a)%n_points(b)
          write(19,fmt='(3(F13.8,2X))') pos1_dn(a)%point_x_y_z(b,c,1:3)/units_factor
        end do
      end do
    end do
    close(unit=19)

  !
  ! GENERATE Nuc_FOD.xyz. For PyFLOSIC
  !
  else if (output_mode == 'PyFLOSIC') then
    open(unit=19,file=output_name,status='unknown',action='write')
    write (junk, '(I4)') size(pos1_up)+counter_up+counter_dn                     ! number of entries in the xyz file
    write(19,fmt='(A)') adjustl(junk)
    write(19,fmt='(A)') "sym_fod1='X' sym_fod2='He'"
    do a = 1, size(pos1_up)
      if (pos1_up(a)%elements(2:2) == '_') then
        write(19,fmt='(A4,3X,3(F13.8,2X))') pos1_up(a)%elements(1:1),pos1_up(a)%center_x_y_z(1:3)*0.529177D0/units_factor ! always in angstrom
      else
        write(19,fmt='(A4,3X,3(F13.8,2X))') pos1_up(a)%elements(1:2),pos1_up(a)%center_x_y_z(1:3)*0.529177D0/units_factor
      end if
    end do
    do a = 1, size(pos1_up)
      do b = 1, pos1_up(a)%n_shells
        do c = 1, pos1_up(a)%n_points(b)
          write(19,fmt='(A3,4X,3(F13.8,2X))') 'X',pos1_up(a)%point_x_y_z(b,c,1:3)*0.529177D0/units_factor
        end do
      end do
    end do
    do a = 1, size(pos1_up)
      do b = 1, pos1_dn(a)%n_shells
        do c = 1, pos1_dn(a)%n_points(b)
          write(19,fmt='(A4,3X,3(F13.8,2X))') 'He',pos1_dn(a)%point_x_y_z(b,c,1:3)*0.529177D0/units_factor
        end do
      end do
    end do
    close(unit=19)

  else
    write(6,*) 'output_mode not recognized. Valid values are NRLMOL and PyFLOSIC'
  end if

  deallocate(bond_pattern)
  deallocate(con_mat)
  deallocate(lone_fods)
  deallocate(bond_count_up)
  deallocate(bond_count_dn)
end if


! Deallocate everything
do a = 1, number_of_centers
  deallocate(pos1_up(a)%n_points)
  deallocate(pos1_up(a)%r_theta_phi)
  deallocate(pos1_up(a)%point_x_y_z)
  deallocate(pos2_up(a)%n_points)
  deallocate(pos2_up(a)%r_theta_phi)
  deallocate(pos2_up(a)%point_x_y_z)
  deallocate(pos1_dn(a)%n_points)                                              
  deallocate(pos1_dn(a)%r_theta_phi)
  deallocate(pos1_dn(a)%point_x_y_z)
  deallocate(pos2_dn(a)%n_points)
  deallocate(pos2_dn(a)%r_theta_phi)
  deallocate(pos2_dn(a)%point_x_y_z)
end do

!end program fodMC
end subroutine get_guess


subroutine database(species,elem,Qpseudo,Qcore,Rcov,shellUP,shellDN,N_UP,N_DN,R_UP,R_DN)
        ! element_number
        ! pseudo_charge 
        ! core_charge
        ! covalent radius
        ! shells_up, shells_dn
        !  Temporary arrays. To be written correctly later on
        ! points per shell UP and DN
        ! Radii for each shell UP and DN
!###########################################
! All average radii for the atoms (in bohr). 
! Structured as follows:
! 
! Element_symbol        Element_number          Pseudo_potential_electrons      No_of_core_electrons            Covalent_radius         Comment
! number_of_UP_shells   number_of_DN_shells     always at least 1. The number of points on this shell can be zero (if one spin channel shall be neglected)
! radius_UP_1           number_of_points_UP_1
! radius_UP_2           number_of_points_UP_2
! ....
! radius_DN_1           number_of_points_DN_1
! ...
character(len=17), intent(in)  :: species
integer, intent(inout)         :: elem, Qpseudo, Qcore, shellUP, shellDN, N_UP(10), N_DN(10)
real(8), intent(inout)         :: Rcov, R_UP(10), R_DN(10)

! All-electron, large core pseudopotentials (ECP_LC), or small core pseudopotentials (ECP_SC)
! Hydrogen
if ((species == 'H').or.(species == 'H_ECP_LC').or.(species == 'H_ECP_SC')) then
  elem    = 1
  Qpseudo = 0
  Qcore   = 0
  Rcov    = 0.605D0
  shellUP = 1
  shellDN = 1
  N_UP(1) = 1
  R_UP(1) = 0.300D0
  N_DN(1) = 0
  R_DN(1) = 0.300D0
! Helium
else if ((species == 'He').or.(species == 'He_ECP_LC').or.(species == 'He_ECP_SC')) then
  elem    = 2
  Qpseudo = 0
  Qcore   = 0
  Rcov    = 1.757D0
  shellUP = 1
  shellDN = 1
  N_UP(1) = 1
  R_UP(1) = 0.300D0
  N_DN(1) = 1
  R_DN(1) = 0.300D0
! Lithium
else if ((species == 'Li').or.(species == 'Li_ECP_LC').or.(species == 'Li_ECP_SC')) then
  elem    = 3
  Qcore   = 2
  Rcov    = 2.324D0
  if (species == 'Li') then
    Qpseudo = 0
    shellUP = 2
    shellDN = 2
    N_UP(1) = 1
    R_UP(1) = 0.138D0
    N_UP(2) = 1
    R_UP(2) = 2.887D0
    N_DN(1) = 1
    R_DN(1) = 0.101D0
    N_DN(2) = 0
    R_DN(2) = 2.887D0
  end if
  if ((species == 'Li_ECP_LC').or.(species == 'Li_ECP_SC')) then
    Qpseudo = 2
    shellUP = 1
    shellDN = 1
    N_UP(1) = 1
    R_UP(1) = 2.887D0
    N_DN(1) = 0
    R_DN(1) = 2.887D0
  end if
! Beryllium
else if ((species == 'Be').or.(species == 'Be_ECP_LC').or.(species == 'Be_ECP_SC')) then
  elem    = 4
  Qcore   = 2
  Rcov    = 1.701D0
  if (species == 'Be') then
    Qpseudo = 0
    shellUP = 2
    shellDN = 2
    N_UP(1) = 1
    R_UP(1) = 0.078D0
    N_UP(2) = 1
    R_UP(2) = 2.083D0
    N_DN(1) = 1
    R_DN(1) = 0.078D0
    N_DN(2) = 1
    R_DN(2) = 2.083D0
  end if
  if ((species == 'Be_ECP_LC').or.(species == 'Be_ECP_SC')) then
    Qpseudo = 2
    shellUP = 1
    shellDN = 1
    N_UP(1) = 1
    R_UP(1) = 2.083D0
    N_DN(1) = 1
    R_DN(1) = 2.083D0
  end if
! Boron
else if ((species == 'B').or.(species == 'B_ECP_LC').or.(species == 'B_ECP_SC')) then
  elem    = 5
  Qcore   = 2
  Rcov    = 1.549D0
  if (species == 'B') then
    Qpseudo = 0
    shellUP = 2
    shellDN = 2
    N_UP(1) = 1
    R_UP(1) = 0.035D0
    N_UP(2) = 2
    R_UP(2) = 2.013D0
    N_DN(1) = 1
    R_DN(1) = 0.023D0
    N_DN(2) = 1
    R_DN(2) = 2.013D0
  end if
  if ((species == 'B_ECP_LC').or.(species == 'B_ECP_SC')) then
    Qpseudo = 2
    shellUP = 1
    shellDN = 1
    N_UP(1) = 2
    R_UP(1) = 2.013D0
    N_DN(1) = 1
    R_DN(1) = 2.013D0
  end if
! Carbon
else if ((species == 'C').or.(species == 'C_ECP_LC').or.(species == 'C_ECP_SC')) then
  elem    = 6
  Qcore   = 2
  Rcov    = 1.455D0
  if (species == 'C') then
    Qpseudo = 0
    shellUP = 2
    shellDN = 2
    N_UP(1) = 1
    R_UP(1) = 0.083D0
    N_UP(2) = 3
    R_UP(2) = 2.002D0
    N_DN(1) = 1
    R_DN(1) = 0.069D0
    N_DN(2) = 1
    R_DN(2) = 2.002D0
  end if
  if ((species == 'C_ECP_LC').or.(species == 'C_ECP_SC')) then
    Qpseudo = 2
    shellUP = 1
    shellDN = 1
    N_UP(1) = 3
    R_UP(1) = 2.002D0
    N_DN(1) = 1
    R_DN(1) = 2.002D0
  end if
! Nitrogen
else if ((species == 'N').or.(species == 'N_ECP_LC').or.(species == 'N_ECP_SC')) then
  elem    = 7
  Qcore   = 2
  Rcov    = 1.417D0
  if (species == 'N') then
    Qpseudo = 0
    shellUP = 2
    shellDN = 2
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 1.559D0
    N_DN(1) = 1
    R_DN(1) = 0.053D0
    N_DN(2) = 1
    R_DN(2) = 1.499D0
  end if
  if ((species == 'N_ECP_LC').or.(species == 'N_ECP_SC')) then
    Qpseudo = 2
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 1.559D0
    N_DN(1) = 1
    R_DN(1) = 1.499D0
  end if
! Oxygen
else if ((species == 'O').or.(species == 'O_ECP_LC').or.(species == 'O_ECP_SC')) then
  elem    = 8
  Qcore   = 2
  Rcov    = 1.379D0
  if (species == 'O') then
    Qpseudo = 0
    shellUP = 2
    shellDN = 2
    N_UP(1) = 1
    R_UP(1) = 0.003D0
    N_UP(2) = 4
    R_UP(2) = 1.358D0
    N_DN(1) = 1
    R_DN(1) = 0.046D0
    N_DN(2) = 2
    R_DN(2) = 1.511D0
  end if
  if ((species == 'O_ECP_LC').or.(species == 'O_ECP_SC')) then
    Qpseudo = 2
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 1.358D0
    N_DN(1) = 2
    R_DN(1) = 1.511D0
  end if
! Fluorine
else if ((species == 'F').or.(species == 'F_ECP_LC').or.(species == 'F_ECP_SC')) then
  elem    = 9
  Qcore   = 2
  Rcov    = 1.361D0
  if (species == 'F') then
    Qpseudo = 0
    shellUP = 2
    shellDN = 2
    N_UP(1) = 1
    R_UP(1) = 0.002D0
    N_UP(2) = 4
    R_UP(2) = 1.204D0
    N_DN(1) = 1
    R_DN(1) = 0.002D0
    N_DN(2) = 3
    R_DN(2) = 1.406D0
  end if
  if ((species == 'F_ECP_LC').or.(species == 'F_ECP_SC')) then
    Qpseudo = 2
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 1.204D0
    N_DN(1) = 3
    R_DN(1) = 1.406D0
  end if
! Neon
else if ((species == 'Ne').or.(species == 'Ne_ECP_LC').or.(species == 'Ne_ECP_SC')) then
  elem    = 10
  Qcore   = 2
  Rcov    = 1.342D0
  if (species == 'Ne') then
    Qpseudo = 0
    shellUP = 2
    shellDN = 2
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 1.079D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 1.079D0
  end if
  if ((species == 'Ne_ECP_LC').or.(species == 'Ne_ECP_SC')) then
    Qpseudo = 2
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 1.079D0
    N_DN(1) = 4
    R_DN(1) = 1.079D0
  end if
! Sodium
else if ((species == 'Na').or.(species == 'Na_ECP_LC').or.(species == 'Na_ECP_SC')) then
  elem    = 11
  Qcore   = 10
  Rcov    = 2.910D0
  if (species == 'Na') then
    Qpseudo = 0
    shellUP = 3
    shellDN = 3
    N_UP(1) = 1
    R_UP(1) = 0.002D0
    N_UP(2) = 4
    R_UP(2) = 0.890D0
    N_UP(3) = 1
    R_UP(3) = 4.829D0
    N_DN(1) = 1
    R_DN(1) = 0.002D0
    N_DN(2) = 4
    R_DN(2) = 0.890D0
    N_DN(3) = 0
    R_DN(3) = 4.829D0
  end if
  if (species == 'Na_ECP_SC') then
    Qpseudo = 2
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 0.890D0
    N_UP(2) = 1
    R_UP(2) = 4.829D0
    N_DN(1) = 4
    R_DN(1) = 0.890D0
    N_DN(2) = 0
    R_DN(2) = 4.829D0
  end if
  if (species == 'Na_ECP_LC') then
    Qpseudo = 10
    shellUP = 1
    shellDN = 1
    N_UP(1) = 1
    R_UP(1) = 4.829D0
    N_DN(1) = 0
    R_DN(1) = 4.829D0
  end if
! Magnesium
else if ((species == 'Mg').or.(species == 'Mg_ECP_LC').or.(species == 'Mg_ECP_SC')) then
  elem    = 12
  Qcore   = 10
  Rcov    = 2.570D0
  if (species == 'Mg') then
    Qpseudo = 0
    shellUP = 3
    shellDN = 3
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.711D0
    N_UP(3) = 1
    R_UP(3) = 3.920D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.711D0
    N_DN(3) = 1
    R_DN(3) = 3.920D0
  end if
  if (species == 'Mg_ECP_SC') then
    Qpseudo = 2
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 0.711D0
    N_UP(2) = 1
    R_UP(2) = 3.920D0
    N_DN(1) = 4
    R_DN(1) = 0.711D0
    N_DN(2) = 1
    R_DN(2) = 3.920D0
  end if
  if (species == 'Mg_ECP_LC') then
    Qpseudo = 10
    shellUP = 1
    shellDN = 1
    N_UP(1) = 1
    R_UP(1) = 3.920D0
    N_DN(1) = 1
    R_DN(1) = 3.920D0
  end if
! Aluminum
else if ((species == 'Al').or.(species == 'Al_ECP_LC').or.(species == 'Al_ECP_SC')) then
  elem    = 13
  Qcore   = 10
  Rcov    = 2.229D0
  if (species == 'Al') then
    Qpseudo = 0
    shellUP = 3
    shellDN = 3
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.635D0
    N_UP(3) = 2
    R_UP(3) = 2.279D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.635D0
    N_DN(3) = 1
    R_DN(3) = 2.950D0
  end if
  if (species == 'Al_ECP_SC') then
    Qpseudo = 2
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 0.635D0
    N_UP(2) = 2
    R_UP(2) = 2.279D0
    N_DN(1) = 4
    R_DN(1) = 0.635D0
    N_DN(2) = 1
    R_DN(2) = 2.950D0
  end if
  if (species == 'Al_ECP_LC') then
    Qpseudo = 10
    shellUP = 1
    shellDN = 1
    N_UP(1) = 2
    R_UP(1) = 2.279D0
    N_DN(1) = 1
    R_DN(1) = 2.950D0
  end if
! Silicon
else if ((species == 'Si').or.(species == 'Si_ECP_LC').or.(species == 'Si_ECP_SC')) then
  elem    = 14
  Qcore   = 10
  Rcov    = 2.098D0
  if (species == 'Si') then
    Qpseudo = 0
    shellUP = 3
    shellDN = 3
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.559D0
    N_UP(3) = 3
    R_UP(3) = 2.051D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.559D0
    N_DN(3) = 1
    R_DN(3) = 2.555D0
  end if
  if (species == 'Si_ECP_SC') then
    Qpseudo = 2
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 0.559D0
    N_UP(2) = 3
    R_UP(2) = 2.051D0
    N_DN(1) = 4
    R_DN(1) = 0.559D0
    N_DN(2) = 1
    R_DN(2) = 2.555D0
  end if
  if (species == 'Si_ECP_LC') then
    Qpseudo = 10
    shellUP = 1
    shellDN = 1
    N_UP(1) = 3
    R_UP(1) = 2.051D0
    N_DN(1) = 1
    R_DN(1) = 2.555D0
  end if
! Phosphorus
else if ((species == 'P').or.(species == 'P_ECP_LC').or.(species == 'P_ECP_SC')) then
  elem    = 15
  Qcore   = 10
  Rcov    = 2.003D0
  if (species == 'P') then
    Qpseudo = 0
    shellUP = 3
    shellDN = 3
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.499D0
    N_UP(3) = 4
    R_UP(3) = 1.819D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.499D0
    N_DN(3) = 1
    R_DN(3) = 2.425D0
  end if
  if (species == 'P_ECP_SC') then
    Qpseudo = 2
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 0.499D0
    N_UP(2) = 4
    R_UP(2) = 1.819D0
    N_DN(1) = 4
    R_DN(1) = 0.499D0
    N_DN(2) = 1
    R_DN(2) = 2.425D0
  end if
  if (species == 'P_ECP_LC') then
    Qpseudo = 10
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 1.819D0
    N_DN(1) = 1
    R_DN(1) = 2.425D0
  end if
! Sulphur
else if ((species == 'S').or.(species == 'S_ECP_LC').or.(species == 'S_ECP_SC')) then
  elem    = 16
  Qcore   = 10
  Rcov    = 1.928D0
  if (species == 'S') then
    Qpseudo = 0
    shellUP = 3
    shellDN = 3
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.465D0
    N_UP(3) = 4
    R_UP(3) = 1.612D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.465D0
    N_DN(3) = 2
    R_DN(3) = 1.609D0
  end if
  if (species == 'S_ECP_SC') then
    Qpseudo = 2
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 0.465D0
    N_UP(2) = 4
    R_UP(2) = 1.612D0
    N_DN(1) = 4
    R_DN(1) = 0.465D0
    N_DN(2) = 2
    R_DN(2) = 1.609D0
  end if
  if (species == 'S_ECP_LC') then
    Qpseudo = 10
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 1.612D0
    N_DN(1) = 2
    R_DN(1) = 1.609D0
  end if
! Chlorine
else if ((species == 'Cl').or.(species == 'Cl_ECP_LC').or.(species == 'Cl_ECP_SC')) then
  elem    = 17
  Qcore   = 10
  Rcov    = 1.871D0
  if (species == 'Cl') then
    Qpseudo = 0
    shellUP = 3
    shellDN = 3
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.417D0
    N_UP(3) = 4
    R_UP(3) = 1.455D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.417D0
    N_DN(3) = 3
    R_DN(3) = 1.480D0
  end if
  if (species == 'Cl_ECP_SC') then
    Qpseudo = 2
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 0.417D0
    N_UP(2) = 4
    R_UP(2) = 1.455D0
    N_DN(1) = 4
    R_DN(1) = 0.417D0
    N_DN(2) = 3
    R_DN(2) = 1.480D0
  end if
  if (species == 'Cl_ECP_LC') then
    Qpseudo = 10
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 1.455D0
    N_DN(1) = 3
    R_DN(1) = 1.480D0
  end if
! Argon
else if ((species == 'Ar').or.(species == 'Ar_ECP_LC').or.(species == 'Ar_ECP_SC')) then
  elem    = 18
  Qcore   = 10
  Rcov    = 1.852D0
  if (species == 'Ar') then
    Qpseudo = 0
    shellUP = 3
    shellDN = 3
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.387D0
    N_UP(3) = 4
    R_UP(3) = 1.330D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.387D0
    N_DN(3) = 4
    R_DN(3) = 1.330D0
  end if
  if (species == 'Ar_ECP_SC') then
    Qpseudo = 2
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 0.387D0
    N_UP(2) = 4
    R_UP(2) = 1.330D0
    N_DN(1) = 4
    R_DN(1) = 0.387D0
    N_DN(2) = 4
    R_DN(2) = 1.330D0
  end if
  if (species == 'Ar_ECP_LC') then
    Qpseudo = 10
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 1.330D0
    N_DN(1) = 4
    R_DN(1) = 1.330D0
  end if
! Potassium
else if ((species == 'K').or.(species == 'K_ECP_LC').or.(species == 'K_ECP_SC')) then
  elem    = 19
  Qcore   = 18
  Rcov    = 3.836D0
  if (species == 'K') then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.355D0
    N_UP(3) = 4
    R_UP(3) = 1.225D0
    N_UP(4) = 1
    R_UP(4) = 6.193D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.355D0
    N_DN(3) = 4
    R_DN(3) = 1.203D0
    N_DN(4) = 0
    R_DN(4) = 6.193D0
  end if
  if (species == 'K_ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 1.225D0
    N_UP(2) = 1
    R_UP(2) = 6.193D0
    N_DN(1) = 4
    R_DN(1) = 1.203D0
    N_DN(2) = 0
    R_DN(2) = 6.193D0
  end if
  if (species == 'K_ECP_LC') then
    Qpseudo = 18
    shellUP = 1
    shellDN = 1
    N_UP(1) = 1
    R_UP(1) = 6.193D0
    N_DN(1) = 0
    R_DN(1) = 6.193D0
  end if
! Calcium
else if ((species == 'Ca').or.(species == 'Ca_ECP_LC').or.(species == 'Ca_ECP_SC')) then
  elem    = 20
  Qcore   = 18
  Rcov    = 3.288D0
  if (species == 'Ca') then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.323D0
    N_UP(3) = 4
    R_UP(3) = 1.285D0
    N_UP(4) = 1
    R_UP(4) = 3.957D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.323D0
    N_DN(3) = 4
    R_DN(3) = 1.285D0
    N_DN(4) = 1
    R_DN(4) = 3.957D0
  end if
  if (species == 'Ca_ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = 4
    R_UP(1) = 1.285D0
    N_UP(2) = 1
    R_UP(2) = 3.957D0
    N_DN(1) = 4
    R_DN(1) = 1.285D0
    N_DN(2) = 1
    R_DN(2) = 3.957D0
  end if
  if (species == 'Ca_ECP_LC') then
    Qpseudo = 18
    shellUP = 1
    shellDN = 1
    N_UP(1) = 1
    R_UP(1) = 3.957D0
    N_DN(1) = 1
    R_DN(1) = 3.957D0
  end if
! [element]_[ECP or not]_[config]
! Scandium, different electronic configurations
else if (species(1:2) == 'Sc') then
  elem    = 21
  Qcore   = 18
  Rcov    = 2.721D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.299D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.299D0

  R_UP(3) = 1.129D0
  R_UP(4) = 4.554D0
  R_DN(3) = 1.129D0
  R_DN(4) = 4.554D0
  ! 3d2 4s1 configuration. 3s3p3d in one shell
  if ((species(4:6) == '4s1').or.(species(11:13) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 6
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 0
      N_DN(3) = 6
      N_DN(4) = 1
    end if
  ! 3d1 4s2 configuration. 3s3p3d in one shell
  else if ((species(4:6) == '4s2').or.(species(11:13) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 5
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 5
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 2
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 4
      N_DN(4) = 2
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Titanium, different electronic configurations
else if (species(1:2) == 'Ti') then
  elem    = 22
  Qcore   = 18
  Rcov    = 2.494D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.285D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.285D0

  R_UP(3) = 1.005D0
  R_UP(4) = 4.355D0
  R_DN(3) = 1.005D0
  R_DN(4) = 4.355D0
  ! 3d3 4s1 configuration. 3s3p3d in one shell
  if ((species(4:6) == '4s1').or.(species(11:13) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 7
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 0
      N_DN(3) = 7
      N_DN(4) = 1
    end if
  ! 3d2 4s2 configuration. 3s3p3d in one shell
  else if ((species(4:6) == '4s2').or.(species(11:13) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 6
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 6
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 3
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 4
      N_DN(4) = 3
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Vanadium, different electronic configurations
else if ((species(1:1) == 'V').and.(species(2:2) == '_')) then
  elem    = 23
  Qcore   = 18
  Rcov    = 2.305D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.265D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.265D0

  R_UP(3) = 1.026D0
  R_UP(4) = 4.300D0
  R_DN(3) = 1.026D0
  R_DN(4) = 4.300D0
  ! 3d4 4s1 configuration. 3s3p3d in one shell
  if ((species(3:5) == '4s1').or.(species(10:12) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 8
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 0
      N_DN(3) = 8
      N_DN(4) = 1
    end if
  ! 3d3 4s2 configuration. 3s3p3d in one shell
  else if ((species(3:5) == '4s2').or.(species(10:12) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 7
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 7
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(3:6) == '3d4s').or.(species(10:13) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 4
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 4
      N_DN(4) = 4
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(3:8) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Chromium, different electronic configurations
else if (species(1:2) == 'Cr') then
  elem    = 24
  Qcore   = 18
  Rcov    = 2.229D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.260D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.260D0

  R_UP(3) = 1.025D0
  R_UP(4) = 4.000D0
  R_DN(3) = 1.025D0
  R_DN(4) = 4.000D0
  ! 3d5 4s1 configuration. 3s3p3d in one shell
  if ((species(4:6) == '4s1').or.(species(11:13) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 0
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d4 4s2 configuration. 3s3p3d in one shell
  else if ((species(4:6) == '4s2').or.(species(11:13) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 8
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 8
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 6
    N_DN(3) = 4
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 0
      N_DN(3) = 4
      N_DN(4) = 6
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Manganese, different electronic configurations
else if (species(1:2) == 'Mn') then
  elem    = 25
  Qcore   = 18
  Rcov    = 2.211D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.240D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.240D0

  R_UP(3) = 0.905D0
  R_UP(4) = 4.500D0
  R_DN(3) = 0.905D0
  R_DN(4) = 4.500D0
  ! 3d6 4s1 configuration. 3s3p3d in one shell
  if ((species(4:6) == '4s1').or.(species(11:13) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 5
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 5
      N_UP(4) = 0
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d5 4s2 configuration. 3s3p3d in one shell
  else if ((species(4:6) == '4s2').or.(species(11:13) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 6
    N_DN(3) = 4
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 1
      N_DN(3) = 4
      N_DN(4) = 6
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Iron, different electronic configurations
else if (species(1:2) == 'Fe') then
  elem    = 26
  Qcore   = 18
  Rcov    = 2.211D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.230D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.230D0

  R_UP(3) = 0.860D0
  R_UP(4) = 4.500D0
  R_DN(3) = 0.860D0
  R_DN(4) = 4.500D0
  ! 3d7 4s1 configuration. 3s3p3d in one shell
  if ((species(4:6) == '4s1').or.(species(11:13) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 6
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 6
      N_UP(4) = 0
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d6 4s2 configuration. 3s3p3d in one shell
  else if ((species(4:6) == '4s2').or.(species(11:13) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 5
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 5
      N_UP(4) = 1
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 6
    N_DN(3) = 4
    N_DN(4) = 2
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 2
      N_DN(3) = 4
      N_DN(4) = 6
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Cobalt, different electronic configurations
else if (species(1:2) == 'Co') then
  elem    = 27
  Qcore   = 18
  Rcov    = 2.291D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.225D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.225D0

  R_UP(3) = 0.825D0
  R_UP(4) = 4.250D0
  R_DN(3) = 0.825D0
  R_DN(4) = 4.250D0
  ! 3d8 4s1 configuration. 3s3p3d in one shell
  if ((species(4:6) == '4s1').or.(species(11:13) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 7
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 7
      N_UP(4) = 0
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d7 4s2 configuration. 3s3p3d in one shell
  else if ((species(4:6) == '4s2').or.(species(11:13) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 6
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 6
      N_UP(4) = 1
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 6
    N_DN(3) = 4
    N_DN(4) = 3
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 3
      N_DN(3) = 4
      N_DN(4) = 6
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Nickel, different electronic configurations
else if (species(1:2) == 'Ni') then
  elem    = 28
  Qcore   = 18
  Rcov    = 2.173D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.210D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.210D0

  R_UP(3) = 0.820D0
  R_UP(4) = 4.200D0
  R_DN(3) = 0.820D0
  R_DN(4) = 4.200D0
  ! 3d9 4s1 configuration. 3s3p3d in one shell
  if ((species(4:6) == '4s1').or.(species(11:13) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 8
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 8
      N_UP(4) = 0
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d8 4s2 configuration. 3s3p3d in one shell
  else if ((species(4:6) == '4s2').or.(species(11:13) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 7
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 7
      N_UP(4) = 1
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 6
    N_DN(3) = 4
    N_DN(4) = 4
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 4
      N_DN(3) = 4
      N_DN(4) = 6
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Copper, different electronic configurations
else if (species(1:2) == 'Cu') then
  elem    = 29
  Qcore   = 18
  Rcov    = 2.211D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.195D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.195D0

  R_UP(3) = 1.130D0
  R_UP(4) = 4.700D0
  R_DN(3) = 1.130D0
  R_DN(4) = 4.700D0
  ! 3d10 4s1 configuration. 3s3p3d in one shell
  if ((species(4:6) == '4s1').or.(species(11:13) == '4s1')) then  ! All-electron OR pseudopotential
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 9
    N_DN(4) = 0
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 9
      N_UP(4) = 0
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d9 4s2 configuration. 3s3p3d in one shell
  else if ((species(4:6) == '4s2').or.(species(11:13) == '4s2')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 9
    N_UP(4) = 1
    N_DN(3) = 8
    N_DN(4) = 1
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 8
      N_UP(4) = 1
      N_DN(3) = 9
      N_DN(4) = 1
    end if
  ! 3d and 4s in one shell
  else if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 6
    N_DN(3) = 4
    N_DN(4) = 5
    ! If Majority == DN
    if (species(len(trim(species))-1:len(trim(species))) == 'DN') then
      N_UP(3) = 4
      N_UP(4) = 5
      N_DN(3) = 4
      N_DN(4) = 6
    end if
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Zinc
else if (species(1:2) == 'Zn') then
  elem    = 30
  Qcore   = 18
  Rcov    = 2.362D0
  ! Core (1s, 2s2p) always the same. Define here
  ! Also, radii for outer shells.
  N_UP(1) = 1
  R_UP(1) = 0.001D0
  N_UP(2) = 4
  R_UP(2) = 0.182D0
  N_DN(1) = 1
  R_DN(1) = 0.001D0
  N_DN(2) = 4
  R_DN(2) = 0.182D0

  R_UP(3) = 0.755D0
  R_UP(4) = 4.745D0
  R_DN(3) = 0.755D0
  R_DN(4) = 4.745D0

  Qpseudo = 0
  shellUP = 4
  shellDN = 4
  N_UP(3) = 9
  N_UP(4) = 1
  N_DN(3) = 9
  N_DN(4) = 1
  ! 3d and 4s in one shell
  if ((species(4:7) == '3d4s').or.(species(11:14) == '3d4s')) then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(3) = 4
    N_UP(4) = 6
    N_DN(3) = 4
    N_DN(4) = 6
  end if
  ! If ECPs -> delete 1s and 2s2p
  if (species(4:9) == 'ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = N_UP(3)
    R_UP(1) = R_UP(3)
    N_UP(2) = N_UP(4)
    R_UP(2) = R_UP(4)
    N_DN(1) = N_DN(3)
    R_DN(1) = R_DN(3)
    N_DN(2) = N_DN(4)
    R_DN(2) = R_DN(4)
  end if
! Gallium
else if ((species == 'Ga').or.(species == 'Ga_ECP_LC').or.(species == 'Ga_ECP_SC')) then
  elem    = 31
  Qcore   = 28
  Rcov    = 2.351D0
  if (species == 'Ga') then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.180D0
    N_UP(3) = 9
    R_UP(3) = 0.710D0
    N_UP(4) = 2
    R_UP(4) = 4.165D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.180D0
    N_DN(3) = 9
    R_DN(3) = 0.710D0
    N_DN(4) = 1
    R_DN(4) = 4.325D0
  end if
  if (species == 'Ga_ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = 9
    R_UP(1) = 0.710D0
    N_UP(2) = 2
    R_UP(2) = 4.165D0
    N_DN(1) = 9
    R_DN(1) = 0.710D0
    N_DN(2) = 1
    R_DN(2) = 4.325D0
  end if
  if (species == 'Ga_ECP_LC') then
    Qpseudo = 28
    shellUP = 1
    shellDN = 1
    N_UP(1) = 2
    R_UP(1) = 4.165D0
    N_DN(1) = 1
    R_DN(1) = 4.325D0
  end if
! Germanium
else if ((species == 'Ge').or.(species == 'Ge_ECP_LC').or.(species == 'Ge_ECP_SC')) then
  elem    = 32
  Qcore   = 28
  Rcov    = 2.305D0
  if (species == 'Ge') then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.173D0
    N_UP(3) = 9
    R_UP(3) = 0.673D0
    N_UP(4) = 3
    R_UP(4) = 3.334D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.173D0
    N_DN(3) = 9
    R_DN(3) = 0.673D0
    N_DN(4) = 1
    R_DN(4) = 3.296D0
  end if
  if (species == 'Ge_ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = 9
    R_UP(1) = 0.673D0
    N_UP(2) = 3
    R_UP(2) = 3.334D0
    N_DN(1) = 9
    R_DN(1) = 0.673D0
    N_DN(2) = 1
    R_DN(2) = 3.296D0
  end if
  if (species == 'Ge_ECP_LC') then
    Qpseudo = 28
    shellUP = 1
    shellDN = 1
    N_UP(1) = 3
    R_UP(1) = 3.334D0
    N_DN(1) = 1
    R_DN(1) = 3.296D0
  end if
! Arsenic
else if ((species == 'As').or.(species == 'As_ECP_LC').or.(species == 'As_ECP_SC')) then
  elem    = 33
  Qcore   = 28
  Rcov    = 2.268D0
  if (species == 'As') then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.166D0
    N_UP(3) = 9
    R_UP(3) = 0.625D0
    N_UP(4) = 4
    R_UP(4) = 3.202D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.166D0
    N_DN(3) = 9
    R_DN(3) = 0.625D0
    N_DN(4) = 1
    R_DN(4) = 2.953D0
  end if
  if (species == 'As_ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = 9
    R_UP(1) = 0.625D0
    N_UP(2) = 4
    R_UP(2) = 3.202D0
    N_DN(1) = 9
    R_DN(1) = 0.625D0
    N_DN(2) = 1
    R_DN(2) = 2.953D0
  end if
  if (species == 'As_ECP_LC') then
    Qpseudo = 28
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 3.202D0
    N_DN(1) = 1
    R_DN(1) = 2.953D0
  end if
! Selenium
else if ((species == 'Se').or.(species == 'Se_ECP_LC').or.(species == 'Se_ECP_SC')) then
  elem    = 34
  Qcore   = 28
  Rcov    = 2.192D0
  if (species == 'Se') then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.159D0
    N_UP(3) = 9
    R_UP(3) = 0.585D0
    N_UP(4) = 4
    R_UP(4) = 3.192D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.159D0
    N_DN(3) = 9
    R_DN(3) = 0.585D0
    N_DN(4) = 2
    R_DN(4) = 2.910D0
  end if
  if (species == 'Se_ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = 9
    R_UP(1) = 0.585D0
    N_UP(2) = 4
    R_UP(2) = 3.192D0
    N_DN(1) = 9
    R_DN(1) = 0.585D0
    N_DN(2) = 2
    R_DN(2) = 2.910D0
  end if
  if (species == 'Se_ECP_LC') then
    Qpseudo = 28
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 3.192D0
    N_DN(1) = 2
    R_DN(1) = 2.910D0
  end if
! Bromium
else if ((species == 'Br').or.(species == 'Br_ECP_LC').or.(species == 'Br_ECP_SC')) then
  elem    = 35
  Qcore   = 28
  Rcov    = 2.154D0
  if (species == 'Br') then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.154D0
    N_UP(3) = 9
    R_UP(3) = 0.560D0
    N_UP(4) = 4
    R_UP(4) = 2.647D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.154D0
    N_DN(3) = 9
    R_DN(3) = 0.560D0
    N_DN(4) = 3
    R_DN(4) = 2.634D0
  end if
  if (species == 'Br_ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = 9
    R_UP(1) = 0.560D0
    N_UP(2) = 4
    R_UP(2) = 2.647D0
    N_DN(1) = 9
    R_DN(1) = 0.560D0
    N_DN(2) = 3
    R_DN(2) = 2.634D0
  end if
  if (species == 'Br_ECP_LC') then
    Qpseudo = 28
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 2.647D0
    N_DN(1) = 3
    R_DN(1) = 2.634D0
  end if
! Krypton
else if ((species == 'Kr').or.(species == 'Kr_ECP_LC').or.(species == 'Kr_ECP_SC')) then
  elem    = 36
  Qcore   = 28
  Rcov    = 2.116D0
  if (species == 'Kr') then
    Qpseudo = 0
    shellUP = 4
    shellDN = 4
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.147D0
    N_UP(3) = 9
    R_UP(3) = 0.523D0
    N_UP(4) = 4
    R_UP(4) = 2.475D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.147D0
    N_DN(3) = 9
    R_DN(3) = 0.523D0
    N_DN(4) = 4
    R_DN(4) = 2.475D0
  end if
  if (species == 'Kr_ECP_SC') then
    Qpseudo = 10
    shellUP = 2
    shellDN = 2
    N_UP(1) = 9
    R_UP(1) = 0.523D0
    N_UP(2) = 4
    R_UP(2) = 2.475D0
    N_DN(1) = 9
    R_DN(1) = 0.523D0
    N_DN(2) = 4
    R_DN(2) = 2.475D0
  end if
  if (species == 'Kr_ECP_LC') then
    Qpseudo = 28
    shellUP = 1
    shellDN = 1
    N_UP(1) = 4
    R_UP(1) = 2.475D0
    N_DN(1) = 4
    R_DN(1) = 2.475D0
  end if
! Zirconium
else if ((species(1:2) == 'Zr').or.(species(1:9) == 'Zr_ECP_LC').or.(species(1:9) == 'Zr_ECP_SC')) then
  elem    = 40
  Qcore   = 36
  Rcov    = 2.797D0
  if (species(1:2) == 'Zr') then
    Qpseudo = 0
    shellUP = 5
    shellDN = 5
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.147D0
    N_UP(3) = 9
    R_UP(3) = 0.523D0
    N_UP(4) = 6
    R_UP(4) = 1.475D0
    N_UP(5) = 1
    R_UP(5) = 3.500D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.147D0
    N_DN(3) = 9
    R_DN(3) = 0.523D0
    N_DN(4) = 4
    R_DN(4) = 1.475D0
    N_DN(5) = 1
    R_DN(5) = 3.500D0
  end if
  if (species(1:9) == 'Zr_ECP_SC') then
    Qpseudo = 10
    shellUP = 3
    shellDN = 3
    N_UP(1) = 9
    R_UP(1) = 0.523D0
    N_UP(2) = 6
    R_UP(2) = 1.475D0
    N_UP(3) = 1
    R_UP(3) = 3.500D0
    N_DN(1) = 9
    R_DN(1) = 0.523D0
    N_DN(2) = 4
    R_DN(2) = 1.475D0
    N_DN(3) = 1
    R_DN(3) = 3.500D0
  end if
  if (species(1:9) == 'Zr_ECP_LC') then
    Qpseudo = 28
    shellUP = 2
    shellDN = 2
    N_UP(1) = 6
    R_UP(1) = 1.475D0
    N_UP(2) = 1
    R_UP(2) = 3.500D0
    N_DN(1) = 4
    R_DN(1) = 1.475D0
    N_DN(2) = 1
    R_DN(2) = 3.500D0
  end if
  ! If LS configuration is desired ->
  if (species(len(trim(species))-1:len(trim(species))) == 'LS') then
    N_UP(shellUP-1) = 5
    N_DN(shellDN-1) = 5
  end if
! Xenon
else if ((species == 'Xe').or.(species == 'Xe_ECP_LC').or.(species == 'Xe_ECP_SC')) then
  elem    = 54
  Qcore   = 46
  Rcov    = 2.476D0
  if (species == 'Xe') then
    Qpseudo = 0
    shellUP = 5
    shellDN = 5
    N_UP(1) = 1
    R_UP(1) = 0.001D0
    N_UP(2) = 4
    R_UP(2) = 0.095D0
    N_UP(3) = 9
    R_UP(3) = 0.273D0
    N_UP(4) = 9
    R_UP(4) = 0.848D0
    N_UP(5) = 1
    R_UP(5) = 2.678D0
    N_DN(1) = 1
    R_DN(1) = 0.001D0
    N_DN(2) = 4
    R_DN(2) = 0.095D0
    N_DN(3) = 9
    R_DN(3) = 0.273D0
    N_DN(4) = 9
    R_DN(4) = 0.848D0
    N_DN(5) = 1
    R_DN(5) = 2.678D0
  end if
  if (species == 'Xe_ECP_SC') then
    Qpseudo = 10
    shellUP = 3
    shellDN = 3
    N_UP(1) = 9
    R_UP(1) = 0.273D0
    N_UP(2) = 9
    R_UP(2) = 0.848D0
    N_UP(3) = 1
    R_UP(3) = 2.678D0
    N_DN(1) = 9
    R_DN(1) = 0.273D0
    N_DN(2) = 9
    R_DN(2) = 0.848D0
    N_DN(3) = 1
    R_DN(3) = 2.678D0
  end if
  if (species == 'Zr_ECP_LC') then
    Qpseudo = 28
    shellUP = 2
    shellDN = 2
    N_UP(1) = 9
    R_UP(1) = 0.848D0
    N_UP(2) = 1
    R_UP(2) = 2.678D0
    N_DN(1) = 9
    R_DN(1) = 0.848D0
    N_DN(2) = 1
    R_DN(2) = 2.678D0
  end if

else
  write(6,*) 'Incorrect species specified!'
end if
return
end subroutine database




subroutine mc_step(rthetaphi1, center_xyz, rthetaphi2, xyz2, stepsize)
real(8), intent(in)  :: rthetaphi1(3)
real(8), intent(in)  :: center_xyz(3)
real(8), intent(in)  :: stepsize
real(8), intent(out) :: rthetaphi2(3), xyz2(3)
real(8)              :: rand1, rand2                ! random numbers to change theta and phi
real(8), parameter   :: pi = 3.14159265358979323846 ! define pi

call random_number(rand1)                         ! random number to change theta
call random_number(rand2)                         ! same for phi
rthetaphi2(1) = rthetaphi1(1)
rthetaphi2(2) = rthetaphi1(2) + (2*rand1 - 1)*pi*stepsize 
rthetaphi2(3) = rthetaphi1(3) + (2*rand2 - 1)*2*pi*stepsize
xyz2(1)       = rthetaphi2(1)*sin(rthetaphi2(2))*cos(rthetaphi2(3)) + center_xyz(1)
xyz2(2)       = rthetaphi2(1)*sin(rthetaphi2(2))*sin(rthetaphi2(3)) + center_xyz(2)
xyz2(3)       = rthetaphi2(1)*cos(rthetaphi2(2)) + center_xyz(3)
return
end subroutine mc_step



subroutine create_rotMat(fullRotMat, stepsize)
real(8), intent(in)  :: stepsize
real(8), intent(out) :: fullRotMat(3,3)
real(8)              :: rotmat_x(3,3), rotmat_y(3,3), rotmat_z(3,3)
real(8)              :: rand1, rand2, rand3
real(8), parameter   :: pi = 3.14159265358979323846 ! define pi

call random_number(rand1)                               ! random number for angle 1.    USE THE SAME ANGLES FOR ALL COORDINATES -> ROTATION
call random_number(rand2)                               ! same for angle 2
call random_number(rand3)                               ! same for angle 3
!
! Rotation based on the rotation around the cartesian axes. Three random numbers for three random angles
!
rand1 = (2*rand1 - 1)*stepsize*pi  ! angle in radians. Should be sufficiently small
rand2 = (2*rand2 - 1)*stepsize*pi  ! angle in radians. Should be sufficiently small
rand3 = (2*rand3 - 1)*stepsize*pi  ! angle in radians. Should be sufficiently small

rotmat_x(1,1:3) = (/ real(1.0,8), real(0.0,8), real(0.0,8) /)
rotmat_x(2,1:3) = (/ real(0.0,8), cos(rand1), -sin(rand1) /)
rotmat_x(3,1:3) = (/ real(0.0,8), sin(rand1),  cos(rand1) /)

rotmat_y(1,1:3) = (/ cos(rand2),  real(0.0,8), sin(rand2) /)
rotmat_y(2,1:3) = (/ real(0.0,8), real(1.0,8), real(0.0,8) /)
rotmat_y(3,1:3) = (/ -sin(rand2), real(0.0,8), cos(rand2) /)

rotmat_z(1,1:3) = (/ cos(rand3), -sin(rand3),  real(0.0,8) /)
rotmat_z(2,1:3) = (/ sin(rand3),  cos(rand3),  real(0.0,8) /)
rotmat_z(3,1:3) = (/ real(0.0,8), real(0.0,8), real(1.0,8) /)

fullRotMat = matmul(rotmat_z,matmul(rotmat_y,rotmat_x))
return
end subroutine create_rotMat


subroutine create_rotMat_bond(fullRotMat,axis_vector,stepsize)
real(8), intent(in)  :: stepsize
real(8), intent(in)  :: axis_vector(3)
real(8), intent(out) :: fullRotMat(3,3)
real(8)              :: len_vector
real(8)              :: norm_vector(3)
real(8)              :: rand1
real(8), parameter   :: pi = 3.14159265358979323846 ! define pi

call random_number(rand1)          ! random number for angle
rand1 = (2*rand1 - 1)*stepsize*10.0*pi  ! angle in radians. Should be sufficiently small
! normalize vector
len_vector = sqrt(sum(axis_vector(:)**2))
norm_vector(:) = axis_vector(:)/len_vector
! generate rotation matrix
fullRotMat(1,1) = cos(rand1) + norm_vector(1)**2*(1 - cos(rand1))
fullRotMat(1,2) = norm_vector(1)*norm_vector(2)*(1 - cos(rand1)) - norm_vector(3)*sin(rand1)
fullRotMat(1,3) = norm_vector(1)*norm_vector(3)*(1 - cos(rand1)) + norm_vector(2)*sin(rand1)
fullRotMat(2,1) = norm_vector(2)*norm_vector(1)*(1 - cos(rand1)) + norm_vector(3)*sin(rand1)
fullRotMat(2,2) = cos(rand1) + norm_vector(2)**2*(1 - cos(rand1))
fullRotMat(2,3) = norm_vector(2)*norm_vector(3)*(1 - cos(rand1)) - norm_vector(1)*sin(rand1)
fullRotMat(3,1) = norm_vector(3)*norm_vector(1)*(1 - cos(rand1)) - norm_vector(2)*sin(rand1)
fullRotMat(3,2) = norm_vector(3)*norm_vector(2)*(1 - cos(rand1)) + norm_vector(1)*sin(rand1)
fullRotMat(3,3) = cos(rand1) + norm_vector(3)**2*(1 - cos(rand1))

return
end subroutine create_rotMat_bond


subroutine create_rotMat_vec1_into_vec2(fullRotMat,vector1,vector2)
! create a rotation matrix to rotate one vector into another -> now needed for bond FODs
real(8), intent(in)  :: vector1(3)   ! 
real(8), intent(in)  :: vector2(3)   ! bond axis
real(8), intent(out) :: fullRotMat(3,3)
real(8)              :: len_vector, cos_angle, angle
real(8)              :: norm_1(3), norm_2(3),cross_prod(3)
!
! normalize vectors
!
len_vector = sqrt(vector1(1)**2 + vector1(2)**2 + vector1(3)**2)
norm_1(1) = vector1(1)/len_vector
norm_1(2) = vector1(2)/len_vector
norm_1(3) = vector1(3)/len_vector
len_vector = sqrt(vector2(1)**2 + vector2(2)**2 + vector2(3)**2)
norm_2(1) = vector2(1)/len_vector
norm_2(2) = vector2(2)/len_vector
norm_2(3) = vector2(3)/len_vector
!
! get angle between vectors over dot_product. They are normalized -> not need to divide by their length!
!
cos_angle = dot_product(norm_1, norm_2) !/(sqrt(sum(vector1(:)**2))*sqrt(sum(vector2(:)**2)))  ! cos angle = dot_product/(len(1)*len(2))
angle     = acos(cos_angle)
!
! if the two vector are identical -> unit matrix for rotation
!
if (abs(cos_angle) > 0.98) then
  fullRotMat(1,1:3) = (/ real(1.0,8), real(0.0,8), real(0.0,8) /)
  fullRotMat(2,1:3) = (/ real(0.0,8), real(1.0,8), real(0.0,8) /)
  fullRotMat(3,1:3) = (/ real(0.0,8), real(0.0,8), real(1.0,8) /)
else
  !
  ! If vector are not identical: get cross product -> rotation axis
  !
  cross_prod(1) = norm_1(2)*norm_2(3) - norm_1(3)*norm_2(2)
  cross_prod(2) = norm_1(3)*norm_2(1) - norm_1(1)*norm_2(3)
  cross_prod(3) = norm_1(1)*norm_2(2) - norm_1(2)*norm_2(1)
  ! needs to be normalized
  len_vector = sqrt(cross_prod(1)**2 + cross_prod(2)**2 + cross_prod(3)**2)
  cross_prod(1) = cross_prod(1)/len_vector
  cross_prod(2) = cross_prod(2)/len_vector
  cross_prod(3) = cross_prod(3)/len_vector

  fullRotMat(1,1) = cos(angle) + cross_prod(1)**2*(1 - cos(angle))
  fullRotMat(1,2) = cross_prod(1)*cross_prod(2)*(1 - cos(angle)) - cross_prod(3)*sin(angle)
  fullRotMat(1,3) = cross_prod(1)*cross_prod(3)*(1 - cos(angle)) + cross_prod(2)*sin(angle)
  fullRotMat(2,1) = cross_prod(2)*cross_prod(1)*(1 - cos(angle)) + cross_prod(3)*sin(angle)
  fullRotMat(2,2) = cos(angle) + cross_prod(2)**2*(1 - cos(angle))
  fullRotMat(2,3) = cross_prod(2)*cross_prod(3)*(1 - cos(angle)) - cross_prod(1)*sin(angle)
  fullRotMat(3,1) = cross_prod(3)*cross_prod(1)*(1 - cos(angle)) - cross_prod(2)*sin(angle)
  fullRotMat(3,2) = cross_prod(3)*cross_prod(2)*(1 - cos(angle)) + cross_prod(1)*sin(angle)
  fullRotMat(3,3) = cos(angle) + cross_prod(3)**2*(1 - cos(angle))
end if

return
end subroutine create_rotMat_vec1_into_vec2



subroutine rotate_pos(fullRotMat, xyz1, center_xyz, xyz2)
real(8), intent(in)  :: fullRotMat(3,3), xyz1(3), center_xyz(3)
real(8), intent(out) :: xyz2(3)
integer              :: a
! rotation at ORIGIN. Move to origin, rotate and move back to center
do a = 1,3
  xyz2(a) = fullRotMat(a,1)*(xyz1(1) - center_xyz(1)) + &
            fullRotMat(a,2)*(xyz1(2) - center_xyz(2)) + &
            fullRotMat(a,3)*(xyz1(3) - center_xyz(3)) + &
            center_xyz(a)
end do
return
end subroutine rotate_pos




subroutine rotate_around_axis(axis_vector, center_of_bond, xyz, stepsize)
real(8), intent(in)    :: axis_vector(3)
real(8), intent(in)    :: center_of_bond(3)         ! shift all pos to the origin
real(8), intent(in)    :: stepsize
real(8), intent(inout) :: xyz(3)
real(8)                :: tmp_xyz(3)
real(8)                :: len_vector
real(8)                :: norm_vector(3)
real(8)                :: full_rot(3,3)
real(8)                :: rand1
real(8), parameter     :: pi = 3.14159265358979323846 ! define pi

call random_number(rand1)          ! random number for angle
rand1 = (2*rand1 - 1)*stepsize*10.0*pi  ! angle in radians. Should be sufficiently small

! normalize vector
len_vector = sqrt(sum(axis_vector(:)**2))
norm_vector(:) = axis_vector(:)/len_vector

full_rot(1,1) = cos(rand1) + norm_vector(1)**2*(1 - cos(rand1))
full_rot(1,2) = norm_vector(1)*norm_vector(2)*(1 - cos(rand1)) - norm_vector(3)*sin(rand1)
full_rot(1,3) = norm_vector(1)*norm_vector(3)*(1 - cos(rand1)) + norm_vector(2)*sin(rand1)
full_rot(2,1) = norm_vector(2)*norm_vector(1)*(1 - cos(rand1)) + norm_vector(3)*sin(rand1)
full_rot(2,2) = cos(rand1) + norm_vector(2)**2*(1 - cos(rand1))
full_rot(2,3) = norm_vector(2)*norm_vector(3)*(1 - cos(rand1)) - norm_vector(1)*sin(rand1)
full_rot(3,1) = norm_vector(3)*norm_vector(1)*(1 - cos(rand1)) - norm_vector(2)*sin(rand1)
full_rot(3,2) = norm_vector(3)*norm_vector(2)*(1 - cos(rand1)) + norm_vector(1)*sin(rand1)
full_rot(3,3) = cos(rand1) + norm_vector(3)**2*(1 - cos(rand1))

tmp_xyz(1) = full_rot(1,1)*(xyz(1)-center_of_bond(1)) + &
           & full_rot(1,2)*(xyz(2)-center_of_bond(2)) + full_rot(1,3)*(xyz(3)-center_of_bond(3))
tmp_xyz(2) = full_rot(2,1)*(xyz(1)-center_of_bond(1)) + &
           & full_rot(2,2)*(xyz(2)-center_of_bond(2)) + full_rot(2,3)*(xyz(3)-center_of_bond(3))
tmp_xyz(3) = full_rot(3,1)*(xyz(1)-center_of_bond(1)) + & 
           & full_rot(3,2)*(xyz(2)-center_of_bond(2)) + full_rot(3,3)*(xyz(3)-center_of_bond(3))

xyz(:) = tmp_xyz(:)+center_of_bond(:)
return
end subroutine rotate_around_axis



subroutine per_vector(bond_vec,center_xyz,per_vec)
real(8), intent(in)    :: bond_vec(3)
real(8), intent(in)    :: center_xyz(3)         
real(8), intent(inout) :: per_vec(3)

! find a vector which is perpendicular to the bond vector

! take atomic position and make cross product between atomic position and bond center ?
per_vec(1) = center_xyz(2)*bond_vec(3) - center_xyz(3)*bond_vec(2)
per_vec(2) = center_xyz(3)*bond_vec(1) - center_xyz(1)*bond_vec(3)
per_vec(3) = center_xyz(1)*bond_vec(2) - center_xyz(2)*bond_vec(1)

!!!!
! NEW TRY FOR PERPENDICULAR VECTOR
!!!!
if (sqrt(sum(per_vec(:)**2)) < 1.0D-6) then                ! if no proper perpendicular vector has been found, use alternative strategy
! find smallest vector component -> build cross product with the axis corresponding to that component     bond_center or bond_vector? might be bond_vector!
  if (abs(bond_vec(1)) <= abs(bond_vec(2)) .and. (abs(bond_vec(1)) <= abs(bond_vec(3)))) then        ! x is smallest
    per_vec(1) = real(0.0,8)
    per_vec(2) = +bond_vec(3)
    per_vec(3) = -bond_vec(2)
  else if (abs(bond_vec(2)) <= abs(bond_vec(1)) .and. (abs(bond_vec(2)) <= abs(bond_vec(3)))) then   ! y is smallest
    per_vec(1) = +bond_vec(3)   ! was - before   ... wouldn't lead to perpendicular vector!!!
    per_vec(2) = real(0.0,8)
    per_vec(3) = -bond_vec(1)
  else                                                                                               ! z is smallest
    per_vec(1) = +bond_vec(2)
    per_vec(2) = -bond_vec(1)
    per_vec(3) = real(0.0,8)
  end if

!!!!
! NEW TRY FOR PERPENDICULAR VECTOR
!!!!
  if (sqrt(sum(per_vec(:)**2)) < 1.0D-6) then           ! if not proper perpendicular vector has been found, use alternative strategy
    if (abs(bond_vec(1)) <= abs(bond_vec(2)) .and. (abs(bond_vec(1)) <= abs(bond_vec(3)))) then        ! x is smallest
      per_vec(1) = real(0.0,8)
      if (abs(bond_vec(2)) >= abs(bond_vec(3))) then                                                   ! y larger than z
        per_vec(2) = real(1.0,8)
        per_vec(3) = -1.0D0*bond_vec(2)/bond_vec(3)
      else
        per_vec(2) = -1.0D0*bond_vec(3)/bond_vec(2)
        per_vec(3) = real(1.0,8)
      end if
    else if (abs(bond_vec(2)) <= abs(bond_vec(1)) .and. (abs(bond_vec(2)) <= abs(bond_vec(3)))) then   ! y is smallest
      per_vec(2) = real(0.0,8)
      if (abs(bond_vec(1)) >= abs(bond_vec(3))) then                                                   ! x larger than z
        per_vec(1) = real(1.0,8)
        per_vec(3) = -1.0D0*bond_vec(1)/bond_vec(3)
      else
        per_vec(1) = -1.0D0*bond_vec(3)/bond_vec(1)
        per_vec(3) = real(1.0,8)
      end if
    else                                                                                               ! z is smallest
      per_vec(3) = real(0.0,8)
      if (abs(bond_vec(1)) >= abs(bond_vec(2))) then                                                   ! x larger than y
        per_vec(1) = real(1.0,8)
        per_vec(2) = -1.0D0*bond_vec(1)/bond_vec(2)
      else
        per_vec(1) = -1.0D0*bond_vec(2)/bond_vec(1)
        per_vec(2) = real(1.0,8)
      end if
    end if
  end if
end if
! normalize perpendicular vector
per_vec(:) = per_vec(:)/sqrt(sum(per_vec(:)**2))

return
end subroutine per_vector


subroutine cart_to_frac(vecA,vecB,vecC,pos_cart,pos_frac)
! Transform cart to fractional. Make sure there are within the unit cell. Transform back to cartesian. Return both cart and frac
real(8), intent(in)    :: vecA(3), vecB(3), vecC(3)
real(8), intent(inout) :: pos_cart(3)
real(8), intent(inout) :: pos_frac(3)
real(8)                :: trans_matrix(3,3)
real(8)                :: determinant
real(8)                :: lenA, lenB, lenC, angleBC, angleAC, angleAB, vol
integer                :: t,f
real(8), parameter     :: pi = 3.14159265358979323846

lenA    = sqrt(vecA(1)**2+vecA(2)**2+vecA(3)**2)
lenB    = sqrt(vecB(1)**2+vecB(2)**2+vecB(3)**2)
lenC    = sqrt(vecC(1)**2+vecC(2)**2+vecC(3)**2)
angleBC = ACOS((vecB(1)*vecC(1) + vecB(2)*vecC(2) + vecB(3)*vecC(3))/(lenB*lenC))*180.0D0/pi
angleAC = ACOS((vecA(1)*vecC(1) + vecA(2)*vecC(2) + vecA(3)*vecC(3))/(lenA*lenC))*180.0D0/pi
angleAB = ACOS((vecA(1)*vecB(1) + vecA(2)*vecB(2) + vecA(3)*vecB(3))/(lenA*lenB))*180.0D0/pi
!!!! Calculate the total unit cell volume using the triple product V = a . (b x c) 
!!!vol     = (vecA(1)*vecB(2)*vecC(3) + vecA(2)*vecB(3)*vecC(1) + vecA(3)*vecB(1)*vecC(2) - &
!!!           vecA(3)*vecB(2)*vecC(1) - vecA(1)*vecB(3)*vecC(2) - vecA(2)*vecB(1)*vecC(3))
! deteminant of the matrix comntaining the cell vectors
determinant = vecA(1)*vecB(2)*vecC(3)+vecB(1)*vecC(2)*vecA(3)+vecC(1)*vecA(2)*vecB(3) - &
              vecA(3)*vecB(2)*vecC(1)-vecB(3)*vecC(2)*vecA(1)-vecC(3)*vecA(2)*vecB(1)
!!!! transformation matrix to get fractional coordinates. It is the inverse of the matrix containing the cell vectors
!!!trans_matrix(1,1) = (vecB(2)*vecC(3)-vecB(3)*vecC(2))/determinant
!!!trans_matrix(1,2) = (vecB(3)*vecC(1)-vecB(1)*vecC(3))/determinant
!!!trans_matrix(1,3) = (vecB(1)*vecC(2)-vecB(2)*vecC(1))/determinant
!!!trans_matrix(2,1) = (vecA(3)*vecC(2)-vecA(2)*vecC(3))/determinant
!!!trans_matrix(2,2) = (vecA(1)*vecC(3)-vecA(3)*vecC(1))/determinant
!!!trans_matrix(2,3) = (vecA(2)*vecC(1)-vecA(1)*vecC(2))/determinant
!!!trans_matrix(3,1) = (vecA(2)*vecB(3)-vecA(3)*vecB(2))/determinant
!!!trans_matrix(3,2) = (vecA(3)*vecB(1)-vecA(1)*vecB(3))/determinant
!!!trans_matrix(3,3) = (vecA(1)*vecB(2)-vecA(2)*vecB(1))/determinant
! transformation matrix to get fractional coordinates. It is the inverse of the matrix containing the cell vectors
trans_matrix(1,1) = (vecB(2)*vecC(3)-vecB(3)*vecC(2))/determinant
trans_matrix(1,2) = (vecA(3)*vecC(2)-vecA(2)*vecC(3))/determinant
trans_matrix(1,3) = (vecA(2)*vecB(3)-vecA(3)*vecB(2))/determinant
trans_matrix(2,1) = (vecB(3)*vecC(1)-vecB(1)*vecC(3))/determinant
trans_matrix(2,2) = (vecA(1)*vecC(3)-vecA(3)*vecC(1))/determinant
trans_matrix(2,3) = (vecA(3)*vecB(1)-vecA(1)*vecB(3))/determinant
trans_matrix(3,1) = (vecB(1)*vecC(2)-vecB(2)*vecC(1))/determinant
trans_matrix(3,2) = (vecA(2)*vecC(1)-vecA(1)*vecC(2))/determinant
trans_matrix(3,3) = (vecA(1)*vecB(2)-vecA(2)*vecB(1))/determinant
! frac = cart*trans_matrix
pos_frac(1) = pos_cart(1)*trans_matrix(1,1) + pos_cart(2)*trans_matrix(2,1) + pos_cart(3)*trans_matrix(3,1)
pos_frac(2) = pos_cart(1)*trans_matrix(1,2) + pos_cart(2)*trans_matrix(2,2) + pos_cart(3)*trans_matrix(3,2)
pos_frac(3) = pos_cart(1)*trans_matrix(1,3) + pos_cart(2)*trans_matrix(2,3) + pos_cart(3)*trans_matrix(3,3)
! make sure that all fractional coordinates are within 0 and 1
do f = 1, 3
  t = 0
  do while (t < 1)
    if (pos_frac(f) > 1) then
      pos_frac(f) = pos_frac(f) - 1
    end if
    if (pos_frac(f) < 0) then
      pos_frac(f) = pos_frac(f) + 1
    end if
    if ((0 <= pos_frac(f)) .and. (pos_frac(f) <= 1)) then
      t = 1
    end if
  end do
end do
! Transfrom back to cartesian. This ensures that all FODs are inside the unit cell
pos_cart(1) = pos_frac(1)*vecA(1) + pos_frac(2)*vecB(1) + pos_frac(3)*vecC(1)
pos_cart(2) = pos_frac(1)*vecA(2) + pos_frac(2)*vecB(2) + pos_frac(3)*vecC(2)
pos_cart(3) = pos_frac(1)*vecA(3) + pos_frac(2)*vecB(3) + pos_frac(3)*vecC(3)

return
end subroutine cart_to_frac


subroutine struct_motif(n_point_tot,n_point,radius,nuc_pos,position_point)     
! make initial structural motifs. For atoms and cores in molecules. Johnson-bodies.    Orient them all along z (to maximize 1/r between them)
! n_point_tot characterizes which structural motif shall be used (e.g. 4 = tetrahedron). 
! n_point specifies the point which shall be assigned
! radius is the correpsonding radiius which shall be used (scaling of original structural motif)
! nuc_pos is the position of the respective atomic position
! position_point is the x,y,z coordinates of the point
integer, intent(in)    :: n_point_tot, n_point
real(8), intent(in)    :: radius
real(8), intent(in)    :: nuc_pos(3)
real(8), intent(inout) :: position_point(3)
real(8), parameter     :: pi = 3.14159265358979323846
real(8)                :: motif_1(3)
real(8)                :: motif_2(2,3)
real(8)                :: motif_3(3,3)
real(8)                :: motif_4(4,3)
real(8)                :: motif_5(5,3)
real(8)                :: motif_6(6,3)
real(8)                :: motif_7(7,3)
real(8)                :: motif_8(8,3)
real(8)                :: motif_9(9,3)
real(8)                :: motif_10(10,3)
real(8)                :: motif_13(13,3)
real(8)                :: motif_15(15,3)
real(8)                :: motif_18(18,3)

! Motif 1 -> single point
motif_1(1:3)    = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
! Motif 2 -> two points in a line
motif_2(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_2(2,1:3) = (/ real(0.0,8), real(0.0,8), real(-1.0,8) /)
! Motif 3 -> equiliteral triangle
motif_3(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_3(2,1:3) = (/ real(sqrt(0.75),8), real(0.0,8), real(-0.5,8) /)
motif_3(3,1:3) = (/ real(-1.0*sqrt(0.75),8), real(0.0,8), real(-0.5,8) /)
! Motif 4 -> tetrahedron
motif_4(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_4(2,1:3) = (/ real(sqrt(8.0/9.0),8), real(0.0,8), real(-1.0/3.0,8) /)
motif_4(3,1:3) = (/ real(-1.0*sqrt(2.0/9.0),8), real(sqrt(2.0/3.0),8), real(-1.0/3.0,8) /)
motif_4(4,1:3) = (/ real(-1.0*sqrt(2.0/9.0),8), real(-1.0*sqrt(2.0/3.0),8), real(-1.0/3.0,8) /)
! Motif 5 -> Triangle + two points in a line (for now)
motif_5(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_5(2,1:3) = (/ real(0.0,8), real(0.0,8), real(-1.0,8) /)
motif_5(3,1:3) = (/ real(1.0,8), real(0.0,8), real(0.0,8) /)
motif_5(4,1:3) = (/ real(-0.5,8), real(sqrt(0.75),8), real(0.0,8) /)
motif_5(5,1:3) = (/ real(-0.5,8), real(-1.0*sqrt(0.75),8), real(0.0,8) /)
! Motif 6 -> Octahedron
motif_6(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_6(2,1:3) = (/ real(0.0,8), real(0.0,8), real(-1.0,8) /)
motif_6(3,1:3) = (/ real(+1.0,8), real(0.0,8), real(0.0,8) /)
motif_6(4,1:3) = (/ real(-1.0,8), real(0.0,8), real(0.0,8) /)
motif_6(5,1:3) = (/ real(0.0,8), real(+1.0,8), real(0.0,8) /)
motif_6(6,1:3) = (/ real(0.0,8), real(-1.0,8), real(0.0,8) /)
! Motif 7 -> Pentagon + 2 points in a line
motif_7(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_7(2,1:3) = (/ real(0.0,8), real(0.0,8), real(-1.0,8) /)
motif_7(3,1:3) = (/ real(+1.0,8), real(0.0,8), real(0.0,8) /)
motif_7(4,1:3) = (/ real(sqrt(1.0 - sin(72.0/360.0*(2.0*pi))),8), real(sin(72.0/360.0*(2.0*pi)),8), real(0.0,8) /)  ! angles in radians
motif_7(5,1:3) = (/ real(sqrt(1.0 - sin(72.0/360.0*(2.0*pi))),8), real(-1.0*sin(72.0/360.0*(2.0*pi)),8), real(0.0,8) /)  ! angles in radians
motif_7(6,1:3) = (/ real(-1.0*sin(54.0/360.0*(2.0*pi)),8), real(sqrt(1.0 - sin(54.0/360.0*(2.0*pi))),8), real(0.0,8) /)  ! angles in radians
motif_7(7,1:3) = (/ real(-1.0*sin(54.0/360.0*(2.0*pi)),8), real(-1.0*sqrt(1.0 - sin(54.0/360.0*(2.0*pi))),8), real(0.0,8) /)  ! angles in radians
! Motif 8 -> twisted cube  (coordinates from optimized points on a sphere) - Symmetrized
motif_8(1,1:3) = (/ real( 0.523842100,8), real( 0.641286608,8), real( 0.5595346325,8) /)
motif_8(2,1:3) = (/ real(-0.523842100,8), real(-0.641286608,8), real( 0.5595346325,8) /)
motif_8(3,1:3) = (/ real(-0.824785975,8), real(-0.082731438,8), real( 0.5595346325,8) /)
motif_8(4,1:3) = (/ real( 0.824785975,8), real( 0.082731438,8), real(-0.5595346325,8) /)
motif_8(5,1:3) = (/ real(-0.641286608,8), real( 0.523842100,8), real(-0.5595346325,8) /)
motif_8(6,1:3) = (/ real( 0.641286608,8), real(-0.523842100,8), real( 0.5595346325,8) /)
motif_8(7,1:3) = (/ real(-0.082731438,8), real( 0.824785975,8), real( 0.5595346325,8) /)
motif_8(8,1:3) = (/ real( 0.082731438,8), real(-0.824785975,8), real(-0.5595346325,8) /)
!!!motif_8(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
!!!motif_8(2,1:3) = (/ real( 0.25873213833899444,8), real( 0.54267827151894577,8), real(-0.79909823199737307,8) /)
!!!motif_8(3,1:3) = (/ real(-0.90657749317642811,8), real( 0.19967266394387995,8), real(-0.37181727150544863,8) /)
!!!motif_8(4,1:3) = (/ real(-0.27516286901850467,8), real( 0.90864087400522586,8), real( 0.31409736914875530,8) /)
!!!motif_8(5,1:3) = (/ real( 0.64785957780839931,8), real(-0.74233833397548044,8), real( 0.17091448403512255,8) /)
!!!motif_8(6,1:3) = (/ real( 0.89976917722989169,8), real( 0.40149697813135576,8), real( 0.17092570010873220,8) /)
!!!motif_8(7,1:3) = (/ real(-0.63141670896554891,8), real(-0.70898843880608209,8), real( 0.31408331144729251,8) /)
!!!motif_8(8,1:3) = (/  real(0.0,8),                 real(-0.60115619469748838,8), real(-0.79910264551689303,8) /)
! Motif 9 -> twisted cube + 1 point at the side (coordinates from optimized points on a sphere) - Symmetrized
motif_9(1,1:3) = (/ real( 0.00000000000000000,8),      real( 0.00000000000000000,8),      real( 1.00000000000000000,8) /)
motif_9(2,1:3) = (/ real( 0.47353004441203156,8),      real( 0.80594647912770400,8),      real( 0.35527598454680115,8) /)
motif_9(3,1:3) = (/ real(-0.47353004441203156,8),      real(-0.80594647912770400,8),      real( 0.35527598454680115,8) /)
motif_9(4,1:3) = (/ real(-0.27326802860984000,8),      real( 0.82178524771742300,8),      real(-0.50000000000000000,8) /)
motif_9(5,1:3) = (/ real( 0.27326802860984000,8),      real(-0.82178524771742300,8),      real(-0.50000000000000000,8) /)
motif_9(6,1:3) = (/ real(-0.66769965479981240,8),      real(-0.22203384174912840,8),      real(-0.71054777716017660,8) /)
motif_9(7,1:3) = (/ real( 0.66769965479981240,8),      real( 0.22203384174912840,8),      real(-0.71054777716017660,8) /)
motif_9(8,1:3) = (/ real( 0.86187128595732240,8),      real(-0.36187760873760340,8),      real( 0.35527598454680115,8) /)
motif_9(9,1:3) = (/ real(-0.86187128595732240,8),      real( 0.36187760873760340,8),      real( 0.35527598454680115,8) /)
!!!motif_9(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
!!!motif_9(2,1:3) = (/ real( 0.47353337042217880,8),      real( 0.80594111308729377,8),      real( 0.35528167598555882,8) /)
!!!motif_9(3,1:3) = (/ real(-0.27326896977780724,8),      real( 0.82179506712346861,8),      real(-0.49997692483868250,8) /)
!!!motif_9(4,1:3) = (/ real( 0.27326708744187284,8),      real(-0.82177542831137740,8),      real(-0.50001023758797603,8) /)
!!!motif_9(5,1:3) = (/ real(-0.47352671840188432,8),      real(-0.80595184516811424,8),      real( 0.35526619093734274,8) /)
!!!motif_9(6,1:3) = (/ real(-0.66770232163854615,8),      real(-0.22202296511526887,8),      real(-0.71054866713357567,8) /)
!!!motif_9(7,1:3) = (/ real( 0.86187138391010965,8),      real(-0.36188184700754855,8),      real( 0.35527348730462649,8) /)
!!!motif_9(8,1:3) = (/ real( 0.66769698796107868,8),      real( 0.22204471838298795,8),      real(-0.71054688718677750,8) /)
!!!motif_9(9,1:3) = (/ real(-0.86187118800453522,8),      real( 0.36187337046765822,8),      real( 0.35528258395967677,8) /)
! Motif 10 -> twisted cube + 2 points on a line (coordinates from optimized points on a sphere)  -  Symmetrized
motif_10(1,1:3)  = (/ real( 0.00000000000000000,8),      real( 0.00000000000000000,8),      real( 1.00000000000000000,8) /)
motif_10(2,1:3)  = (/ real( 0.00000000000000000,8),      real( 0.00000000000000000,8),      real(-1.00000000000000000,8) /)
motif_10(3,1:3)  = (/ real( 0.57697333050312170,8),      real(-0.69888428215415700,8),      real( 0.42268501450052165,8) /)
motif_10(4,1:3)  = (/ real(-0.57697333050312170,8),      real( 0.69888428215415700,8),      real( 0.42268501450052165,8) /)
motif_10(5,1:3)  = (/ real(-0.90216746645970310,8),      real( 0.08620418087144224,8),      real(-0.42268501450052165,8) /)
motif_10(6,1:3)  = (/ real( 0.90216746645970310,8),      real(-0.08620418087144224,8),      real(-0.42268501450052165,8) /)
motif_10(7,1:3)  = (/ real(-0.08620418087144224,8),      real(-0.90216746645970310,8),      real(-0.42268501450052165,8) /)
motif_10(8,1:3)  = (/ real( 0.08620418087144224,8),      real( 0.90216746645970310,8),      real(-0.42268501450052165,8) /)
motif_10(9,1:3)  = (/ real( 0.69888428215415700,8),      real( 0.57697333050312170,8),      real( 0.42268501450052165,8) /)
motif_10(10,1:3) = (/ real(-0.69888428215415700,8),      real(-0.57697333050312170,8),      real( 0.42268501450052165,8) /)
!!!motif_10(1,1:3)  = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
!!!motif_10(2,1:3)  = (/ real(0.0,8), real(0.0,8), real(-1.0,8) /)
!!!motif_10(3,1:3)  = (/ real( 0.57699367577309602,8),      real(-0.69886911015654829,8),      real( 0.42268223829292056,8) /)
!!!motif_10(4,1:3)  = (/ real(-0.90217449849732423,8),      real( 0.08621114899157805,8),      real(-0.42266868939874275,8) /)
!!!motif_10(5,1:3)  = (/ real(-0.08621837568764129,8),      real(-0.90217781352417903,8),      real(-0.42266013221634058,8) /)
!!!motif_10(6,1:3)  = (/ real(-0.57695603747667668,8),      real( 0.69889954929960751,8),      real( 0.42268326733446515,8) /)
!!!motif_10(7,1:3)  = (/ real( 0.69888368699059067,8),      real( 0.57697858771608423,8),      real( 0.42267873049693550,8) /)
!!!motif_10(8,1:3)  = (/ real(-0.69888478216988115,8),      real(-0.57696502104663006,8),      real( 0.42269542473702360,8) /)
!!!motif_10(9,1:3)  = (/ real( 0.90215859614081839,8),      real(-0.08618446515938097,8),      real(-0.42270806956210127,8) /)
!!!motif_10(10,1:3) = (/ real( 0.08620273364716869,8),      real( 0.90215895767649101,8),      real(-0.42270356396564368,8) /)
! Motif 13 -> coordinates from optimized points on a sphere
motif_13(1,1:3)  = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_13(2,1:3)  = (/ real( 0.87314079655928101,8),      real( 0.22583905110122207,8),      real(-0.43199753899152005,8) /)
motif_13(3,1:3)  = (/ real( 0.47331019631752635,8),      real(-0.68447851527191150,8),      real(-0.55449672701815378,8) /)
motif_13(4,1:3)  = (/ real(-0.57272616035461443,8),      real(-0.64913004087085091,8),      real( 0.50061456748459643,8) /)
motif_13(5,1:3)  = (/ real( 0.00000000000000000,8),      real( 0.00000000000000000,8),      real(-0.99866669404274189,8) /)
motif_13(6,1:3)  = (/ real(-0.73810512959591690,8),      real( 0.38449286367475988,8),      real(-0.55440603998636773,8) /)
motif_13(7,1:3)  = (/ real( 0.24329192826524626,8),      real(-0.92043327370046246,8),      real( 0.30596018095562438,8) /)
motif_13(8,1:3)  = (/ real( 0.85761906555009948,8),      real(-0.24899254278372324,8),      real( 0.44999139398081345,8) /)
motif_13(9,1:3)  = (/ real(-0.35380101558582833,8),      real( 0.81997125397645609,8),      real( 0.44996887140917685,8) /)
motif_13(10,1:3) = (/ real( 0.11548367234538193,8),      real( 0.89444558512125383,8),      real(-0.43200767001042928,8) /)
motif_13(11,1:3) = (/ real( 0.58973454278262583,8),      real( 0.66831999446098211,8),      real( 0.45338896774300574,8) /)
motif_13(12,1:3) = (/ real(-0.94353615478643682,8),      real( 0.12678712996613012,8),      real( 0.30604666009756598,8) /)
motif_13(13,1:3) = (/ real(-0.57349289610518150,8),      real(-0.64985984969719979,8),      real(-0.49878660136556108,8) /)
! Motif 15 -> coordinates from optimized points on a sphere
motif_15(1,1:3)  = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_15(2,1:3)  = (/ real( 0.86122864492398410,8),      real( 0.34073707612429743,8),      real( 0.37707221853225092,8) /)  
motif_15(3,1:3)  = (/ real( 0.19984675019212100,8),      real( 0.82276229074494278,8),      real( 0.53209350303277769,8) /)
motif_15(4,1:3)  = (/ real( 0.65712478746789471,8),      real(-0.50707523322986026,8),      real( 0.55772907539330119,8) /)
motif_15(5,1:3)  = (/ real(-0.58354746983944061,8),      real(-0.63989109624301221,8),      real(-0.50001173696849988,8) /)
motif_15(6,1:3)  = (/ real(-0.19983082189999282,8),      real(-0.82279071464998832,8),      real( 0.53205552362837882,8) /)
motif_15(7,1:3)  = (/ real(-0.65712824203376385,8),      real( 0.50708531804185519,8),      real( 0.55771583349603859,8) /)
motif_15(8,1:3)  = (/ real( 0.24022449427532711,8),      real(-0.34019918461013371,8),      real(-0.90915163594741877,8) /)
motif_15(9,1:3)  = (/ real(-0.26280297747251935,8),      real( 0.93946649073329280,8),      real(-0.21985747300689301,8) /)
motif_15(10,1:3) = (/ real(-0.86121795990793426,8),      real(-0.34073763623566755,8),      real( 0.37709612528159886,8) /)
motif_15(11,1:3) = (/ real(-0.24022459455029721,8),      real( 0.34022177836207107,8),      real(-0.90914316428633912,8) /)
motif_15(12,1:3) = (/ real( 0.58354622357858787,8),      real( 0.63989873349067738,8),      real(-0.50000341256914083,8) /)
motif_15(13,1:3) = (/ real( 0.26282599585490291,8),      real(-0.93945045016497686,8),      real(-0.21989848841533588,8) /)
motif_15(14,1:3) = (/ real( 0.91373833124116843,8),      real(-0.22565420872107333,8),      real(-0.33787934064686809,8) /)
motif_15(15,1:3) = (/ real(-0.91374155692039261,8),      real( 0.22565927536461444,8),      real(-0.33786722934984625,8) /)
! Motif 18 (coordinates from optimized points on a sphere) - Symmetrized
motif_18(1,1:3)  = (/ real( 0.00000000000000000,8),      real( 0.00000000000000000,8),      real( 1.00000000000000000,8) /)
motif_18(2,1:3)  = (/ real( 0.97909461138088549,8),      real( 0.00000000000000000,8),      real(-0.20340706000146119,8) /)
motif_18(3,1:3)  = (/ real(-0.97909461138088549,8),      real( 0.00000000000000000,8),      real(-0.20340706000146119,8) /)
motif_18(4,1:3)  = (/ real( 0.00000000000000000,8),      real(-0.73767726267225664,8),      real( 0.67515220301689050,8) /)
motif_18(5,1:3)  = (/ real( 0.00000000000000000,8),      real( 0.73767726267225664,8),      real( 0.67515220301689050,8) /)
motif_18(6,1:3)  = (/ real( 0.69232390573735890,8),      real( 0.69232390573735890,8),      real( 0.20340706000146119,8) /)
motif_18(7,1:3)  = (/ real(-0.69232390573735890,8),      real(-0.69232390573735890,8),      real( 0.20340706000146119,8) /)
motif_18(8,1:3)  = (/ real(-0.52161824888978940,8),      real( 0.52161824888978940,8),      real(-0.67515220301689050,8) /)
motif_18(9,1:3)  = (/ real( 0.52161824888978940,8),      real(-0.52161824888978940,8),      real(-0.67515220301689050,8) /)
motif_18(10,1:3) = (/ real( 0.00000000000000000,8),      real( 0.00000000000000000,8),      real(-1.00000000000000000,8) /)
motif_18(11,1:3) = (/ real( 0.00000000000000000,8),      real(-0.97909461138088549,8),      real(-0.20340706000146119,8) /)
motif_18(12,1:3) = (/ real( 0.00000000000000000,8),      real( 0.97909461138088549,8),      real(-0.20340706000146119,8) /)
motif_18(13,1:3) = (/ real(-0.73767726267225664,8),      real( 0.00000000000000000,8),      real( 0.67515220301689050,8) /)
motif_18(14,1:3) = (/ real( 0.73767726267225664,8),      real( 0.00000000000000000,8),      real( 0.67515220301689050,8) /)
motif_18(15,1:3) = (/ real( 0.69232390573735890,8),      real(-0.69232390573735890,8),      real( 0.20340706000146119,8) /)
motif_18(16,1:3) = (/ real(-0.69232390573735890,8),      real( 0.69232390573735890,8),      real( 0.20340706000146119,8) /)
motif_18(17,1:3) = (/ real(-0.52161824888978940,8),      real(-0.52161824888978940,8),      real(-0.67515220301689050,8) /)
motif_18(18,1:3) = (/ real( 0.52161824888978940,8),      real( 0.52161824888978940,8),      real(-0.67515220301689050,8) /)

! Single point
if (n_point_tot == 1) then
  position_point(:) = motif_1(1:3)*radius + nuc_pos(1:3)
end if
! Two points in a line
if (n_point_tot == 2) then
  position_point(:) = motif_2(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Three points in an equiliteral triangle
if (n_point_tot == 3) then
  position_point(:) = motif_3(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Tetrahedron
if (n_point_tot == 4) then
  position_point(:) = motif_4(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Triangle + 2 points in a line
if (n_point_tot == 5) then
  position_point(:) = motif_5(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Octahedron
if (n_point_tot == 6) then
  position_point(:) = motif_6(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Pentagon + 2 points in a line
if (n_point_tot == 7) then
  position_point(:) = motif_7(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Twisted cube
if (n_point_tot == 8) then
  position_point(:) = motif_8(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Twisted cube + 1 point at the side
if (n_point_tot == 9) then
  position_point(:) = motif_9(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Twisted cube + 2 points on a line
if (n_point_tot == 10) then
  position_point(:) = motif_10(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Motif 13
if (n_point_tot == 13) then
  position_point(:) = motif_13(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Motif 15
if (n_point_tot == 15) then
  position_point(:) = motif_15(n_point,1:3)*radius + nuc_pos(1:3)
end if
! Motif 18
if (n_point_tot == 18) then
  position_point(:) = motif_18(n_point,1:3)*radius + nuc_pos(1:3)
end if
return
end subroutine struct_motif


subroutine struct_motif_bond_lone(n_point_tot,n_point,radius,bond_pos,position_point,per_vec)
! make initial structural motifs. For bond and lone  FODs
! Orient them all along z (to maximize 1/r between them)
! n_point_tot characterizes which structural motif shall be used (e.g. 4 = tetrahedron).
! n_point specifies the point which shall be assigned
! radius is the correpsonding radiius which shall be used (scaling of original structural motif)
! bond_pos is the position of the bond center
! position_point is the x,y,z coordinates of the point
! per_vec is a vector perpendicular to the structural motif -> needed to orient the bond FODs perpendicular to the bond axis
integer, intent(in)    :: n_point_tot, n_point
real(8), intent(in)    :: radius
real(8), intent(in)    :: bond_pos(3)
real(8), intent(inout) :: position_point(3)
real(8), intent(inout) :: per_vec(3)
real(8), parameter     :: pi = 3.14159265358979323846
real(8)                :: motif_1(3)
real(8)                :: motif_2(2,3)
real(8)                :: motif_3(3,3)
real(8)                :: motif_4(4,3)

! Motif 1 -> single point
motif_1(1:3)    = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
! Motif 2 -> two points in a line
motif_2(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_2(2,1:3) = (/ real(0.0,8), real(0.0,8), real(-1.0,8) /)
! Motif 3 -> equiliteral triangle
motif_3(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_3(2,1:3) = (/ real(sqrt(0.75),8), real(0.0,8), real(-0.5,8) /)
motif_3(3,1:3) = (/ real(-1.0*sqrt(0.75),8), real(0.0,8), real(-0.5,8) /)
! Motif 4 -> ttriangle + 1 in the middle
motif_4(1,1:3) = (/ real(0.0,8), real(0.0,8), real(+1.0,8) /)
motif_4(2,1:3) = (/ real(sqrt(0.75),8), real(0.0,8), real(-0.5,8) /)
motif_4(3,1:3) = (/ real(-1.0*sqrt(0.75),8), real(0.0,8), real(-0.5,8) /)
motif_4(4,1:3) = (/ real(0.0,8), real(0.0,8), real(0.0,8) /)

! Single point
if (n_point_tot == 1) then
  position_point(:) = motif_1(1:3)*radius + bond_pos(1:3)
  per_vec(1:3) = (/ real(+1.0,8), real(0.0,8), real(0.0,8) /)
end if
! Two points in a line
if (n_point_tot == 2) then
  position_point(:) = motif_2(n_point,1:3)*radius + bond_pos(1:3)
  per_vec(1:3) = (/ real(+1.0,8), real(0.0,8), real(0.0,8) /)
end if
! Three points in an equiliteral triangle
if (n_point_tot == 3) then
  position_point(:) = motif_3(n_point,1:3)*radius + bond_pos(1:3)
  per_vec(1:3) = (/ real(0.0,8), real(+1.0,8), real(0.0,8) /)
end if
! Triangle + 1 in the middle
if (n_point_tot == 4) then
  position_point(:) = motif_4(n_point,1:3)*radius + bond_pos(1:3)
  per_vec(1:3) = (/ real(0.0,8), real(+1.0,8), real(0.0,8) /)
end if
return
end subroutine struct_motif_bond_lone


! End module definition
end module fodmc_mod




program fodMC
  USE fodmc_mod
  call get_guess('PyFLOSIC','mol03.xyz')
  !call get_guess('NRLMOL','')
end program fodMC 
