subroutine init_lattice(this, length_x, length_y, length_z, &
t_periodic_x, t_periodic_y, t_periodic_z, t_bipartite_order)
! and write the first dummy initialize
class(lattice) :: this
integer, intent(in) :: length_x, length_y, length_z
logical, intent(in) :: t_periodic_x, t_periodic_y, t_periodic_z
logical, intent(in), optional :: t_bipartite_order
character(*), parameter :: this_routine = "init_lattice"
integer :: n_sites, i
logical :: t_bipartite_order_
def_default(t_bipartite_order_, t_bipartite_order, .false.)
n_sites = this%calc_nsites(length_x, length_y, length_z)
! and for the rest i can call general routines:
call this%set_nsites(n_sites)
call this%set_periodic(t_periodic_x, t_periodic_y, t_periodic_z)
select type (this)
! well i cannot init type is (lattice) if i choose to make it
! abstract. since it is not allowed to ever be intantiated..
class is (chain)
! set some defaults for the chain lattice type
call this%set_ndim(DIM_CHAIN)
call this%set_length(length_x, length_y)
! if incorrect length input it is caught in the calc_nsites above..
if (this%get_length() == 1) then
call this%set_nconnect_max(0)
else if (this%get_length() == 2 .and. (.not. this%is_periodic())) then
call this%set_nconnect_max(1)
else
call this%set_nconnect_max(N_CONNECT_MAX_CHAIN)
end if
this%lat_vec(1, 1) = length_x
! the type specific routine deal with the check of the
! length!
! i should not call this set_nsites since this really should
! just imply that it set the variable
! introduce a second routine, which first determines the
! number of sites depending on the lattice type
! how should i define the lattice k_vectors..
this%k_vec(1, 1) = length_x
this%t_bipartite_order = t_bipartite_order_
class is (rectangle)
call this%set_ndim(DIM_RECT)
call this%set_length(length_x, length_y)
if (this%get_length(1) == 2 .and. this%get_length(2) == 2) then
if (.not. this%is_periodic(1) .and. this%is_periodic(2)) then
call this%set_nconnect_max(3)
else if (.not. this%is_periodic(2) .and. this%is_periodic(1)) then
call this%set_nconnect_max(3)
else if (this%is_periodic()) then
call this%set_nconnect_max(4)
else if (.not. this%is_periodic()) then
call this%set_nconnect_max(2)
end if
else
call this%set_nconnect_max(4)
end if
this%lat_vec(1, 1) = this%length(1)
this%lat_vec(2, 2) = this%length(2)
! i also need to assign the lattice k-vectors..
! and i need to do it correctly..
this%k_vec(1, 1) = this%length(1)
this%k_vec(2, 2) = this%length(2)
this%t_bipartite_order = t_bipartite_order_
class is (tilted)
call this%set_ndim(DIM_RECT)
! for the tilted we deal internally always with x as the
! lower of the two inputs. due to symmetry this does not
! make a difference
! and do not allow a 1xY or Yx1 lattice, since this implementation
! annoys me too much!
if (length_x == 1 .or. length_y == 1) then
call stop_all(this_routine, "incorrect size for tilted lattice!")
end if
call this%set_length(min(length_x, length_y), max(length_x, length_y))
call this%set_nconnect_max(4)
this%lat_vec(1:2, 1) = [this%length(1), this%length(1)]
this%lat_vec(1:2, 2) = [-this%length(2), this%length(2)]
this%k_vec(1:2, 1) = [this%length(1), this%length(1)]
this%k_vec(1:2, 2) = [-this%length(2), this%length(2)]
this%t_bipartite_order = t_bipartite_order_
class is (ole)
call this%set_ndim(DIM_RECT)
if (length_x < 2 .or. length_y < 2 .or. length_x == length_y) then
call stop_all(this_routine, "incorrect size for Oles Cluster")
end if
call this%set_length(min(length_x, length_y), max(length_x, length_y))
call this%set_nconnect_max(4)
this%lat_vec(1:2, 1) = [this%length(1), this%length(1)]
this%lat_vec(1:2, 2) = [-this%length(2), this%length(1)]
this%k_vec(1:2, 1) = [this%length(1), this%length(1)]
this%k_vec(1:2, 2) = [-this%length(1), this%length(2)]
if (t_bipartite_order_) then
call stop_all(this_routine, &
"bipartite order not yet implemented for Ole lattice")
end if
class is (sujun)
call this%set_ndim(DIM_RECT)
if (length_x /= 1 .or. length_y /= 3) then
call stop_all(this_routine, "incorrect size for Sujun cluster")
end if
call this%set_length(1,3)
call this%set_nconnect_max(4)
this%lat_vec(1:2, 1) = [1,3]
this%lat_vec(1:2, 2) = [-3,1]
! k-vec todo..
class is (ext_input)
call read_lattice_struct(this)
class is (cube)
call this%set_ndim(DIM_CUBE)
call this%set_length(length_x, length_y, length_z)
call this%set_nconnect_max(6)
this%lat_vec(1, 1) = this%length(1)
this%lat_vec(2, 2) = this%length(2)
this%lat_vec(3, 3) = this%length(3)
this%k_vec(1, 1) = this%length(1)
this%k_vec(2, 2) = this%length(2)
this%k_vec(3, 3) = this%length(3)
if (t_bipartite_order_) then
call stop_all(this_routine, &
"bipartite order not yet implemented for cubic lattice")
end if
class is (triangular)
call this%set_ndim(DIM_RECT)
call this%set_length(length_x, length_y)
! for a filling with triangles the maximum connection is 6!
call this%set_nconnect_max(6)
! todo: set lattice vector! and figure that out correctly!
! and write a more general routine to set the lattice
! vectors for all types of lattices!
class is (hexagonal)
call this%set_ndim(DIM_RECT)
call this%set_length(length_x, length_y, length_z)
call this%set_nconnect_max(3)
class is (kagome)
call this%set_ndim(DIM_RECT)
call this%set_length(length_x, length_y, length_z)
call this%set_nconnect_max(4)
class is (star)
call this%set_ndim(DIM_STAR)
call this%set_nconnect_max(n_sites - 1)
! for the 'star' geometry the special point in the middle
! is connected to all the others.. so i need to calc n_sites here.
! also check here if something went wrong in the input:
if (t_periodic_x .or. t_periodic_y) then
call stop_all(this_routine, &
"incorrect initialization info: requested periodic 'star' geometry!")
end if
class is (aim_chain)
! do stuff
call this%set_ndim(DIM_CHAIN)
call this%set_length(length_x, length_y)
! the neighbors is a bit complicated in this case..
! although it is a chain.. so it should not have more than
! one impurity!
if (length_x > 1) then
call stop_all(this_routine, &
"more than 1 impurity taken in tha aim_chain setup!")
end if
if (length_y == 1) then
call this%set_nconnect_max(1)
else
call this%set_nconnect_max(N_CONNECT_MAX_CHAIN)
end if
! i can use class specific routine in this block
call this%set_n_imps(length_x)
call this%set_n_bath(length_y)
allocate(this%impurity_sites(length_x))
allocate(this%bath_sites(length_y))
this%impurity_sites = [(i, i=1, length_x)]
this%bath_sites = [(length_x + i, i=1, length_y)]
class is (aim_star)
! this is the star with only 1 impurity for now..
! i still have to think how to efficiently setup up a
! cluster impurity..
! i guess i have to decide on a lattice and a ab-initio
! cluster impurity! thats good yeah
call this%set_ndim(DIM_STAR)
! number of bath sites is the maximal connectivity
call this%set_nconnect_max(length_y)
! also the one-site impurity can't be periodic!
if (t_periodic_x .or. t_periodic_y) then
call stop_all(this_routine, &
"incorrect initialization info: requested periodic 'star' geometry!")
end if
if (length_x > 1) then
call stop_all(this_routine, &
"aim_star only implemented for one impurity!")
end if
call this%set_n_imps(length_x)
call this%set_n_bath(length_y)
allocate(this%impurity_sites(length_x))
allocate(this%bath_sites(length_y))
this%impurity_sites = [(i, i=1, length_x)]
this%bath_sites = [(length_x + i, i=1, length_y)]
class default
call stop_all(this_routine, "unexpected lattice type!")
end select
! do i want to allocate sites here or in the initializer?
! well the specific site initializer will be different for all the
! types of lattices.. so best would be to do everything which is
! common to all routine here!
call this%allocate_sites(n_sites)
call this%initialize_sites()
! and fill the lookup table for the site index determination from k vectors
if (t_k_space_hubbard .or. (t_trans_corr_hop .and. t_new_real_space_hubbard)) then
call this%initialize_lu_table()
end if
end subroutine init_lattice