1!
2! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino
3! Copyright (C) 2007-2009 Jesse Noffsinger, Brad Malone, Feliciano Giustino
4!
5! This file is distributed under the terms of the GNU General Public
6! License. See the file `LICENSE' in the root directory of the
7! present distribution, or http://www.gnu.org/copyleft.gpl.txt .
8!
9!-----------------------------------------------------------------------
10MODULE polaron
11    USE kinds,  ONLY : dp
12    IMPLICIT NONE
13    ! Data block, try to keep it to minimal
14    COMPLEX(KIND = DP), ALLOCATABLE :: epfall(:, :, :, :, :)
15    !! el-ph element for all local k and all q
16    !! epfall need to be filled in ephwann_shuffle
17    COMPLEX(KIND = DP), ALLOCATABLE :: ufall(:, :, :)
18    !! el-ph element for all local k and all q
19    !! epfall need to be filled in ephwann_shuffle
20    COMPLEX(KIND = DP), ALLOCATABLE :: Hamil(:, :)
21    !! Hamil need to be passed to h_psi because the parameter space is fixed
22    !! to meet the requirement of Davidson diagonalization. Ugly but workable.
23    COMPLEX(KIND = DP), ALLOCATABLE :: eigVec(:, :)
24    !! polaron eigenvector
25    REAL(KIND = DP),    ALLOCATABLE :: etf_all(:, :)
26    !! Gather all the eigenvalues
27    INTEGER,            ALLOCATABLE :: ikq_all(:, :), kpg_map(:)
28    !
29    PUBLIC  :: wfc_elec, interp_plrn_wf, interp_plrn_bq, plot_plrn_wf
30CONTAINS
31    !
32    !-----------------------------------------------------------------------
33    SUBROUTINE interp_plrn_wf(nrr_k, ndegen_k, irvec_r, dims)
34        USE io_global,     ONLY : stdout, ionode
35
36        IMPLICIT NONE
37
38        INTEGER, INTENT (IN) :: nrr_k, dims, ndegen_k(:,:,:) ! ! Added for polaron calculations by Chao Lian.
39        REAL(DP), INTENT (IN) :: irvec_r(3, nrr_k)
40        COMPLEX(DP), ALLOCATABLE :: eigvec_wan(:, :)
41        INTEGER :: nkf1_p, nkf2_p, nkf3_p, nktotf_p, nbndsub_p
42    END SUBROUTINE
43    !
44    !-----------------------------------------------------------------------
45    SUBROUTINE interp_plrn_bq(nrr_q, ndegen_q, irvec_q)
46        USE epwcom,        ONLY : nkf1, nkf2, nkf3, nbndsub
47        USE elph2, only : xqf, wf, nqtotf
48        USE modes,         ONLY : nmodes
49        USE constants_epw, only : eps8, czero, one, two, twopi, ci
50        USE ions_base,     ONLY : nat, amass, ityp, tau
51        USE wan2bloch, only : dynwan2bloch
52
53        IMPLICIT NONE
54        INTEGER, INTENT (IN) :: nrr_q, ndegen_q(:,:,:) ! ! Added for polaron calculations by Chao Lian.
55        INTEGER, INTENT (IN) :: irvec_q(3, nrr_q)
56
57        INTEGER :: dtau_file
58        INTEGER :: nkf1_p, nkf2_p, nkf3_p, nktotf_p, nat_p
59
60        INTEGER :: iq, inu, ierr, imu, na, iatm, idir
61        INTEGER :: icount, ix, iy, iz, bmat_file
62        COMPLEX(DP) :: ctemp, shift(3)
63
64        COMPLEX(DP), ALLOCATABLE :: uf(:, :), Bmat(:,:)
65        COMPLEX(DP),  ALLOCATABLE :: dtau(:, :)
66        REAL(DP),  ALLOCATABLE :: w2(:)
67        REAL(KIND=dp) :: xxq(3)
68        COMPLEX(KIND=dp) :: expTable(3)
69
70    END SUBROUTINE
71
72    SUBROUTINE wfc_elec (nrr_k, ndegen_k, irvec_r, dims)
73        !
74        ! Self consistency calculation of polaron wavefunction.
75        ! Rewritten by Chao Lian based on the implementation by Danny Sio.
76        !
77        USE modes,         ONLY : nmodes
78        USE constants_epw, ONLY : ryd2mev, one, ryd2ev, two, zero
79        USE constants_epw, ONLY : czero, cone, pi, ci, twopi, eps6, eps8, eps5
80        USE epwcom,        ONLY : num_cbands, polaron_type, sigma_plrn, full_diagon_plrn
81        USE epwcom,        ONLY : r01, r02, r03, nPlrn, conv_thr_polaron, cb_shift
82        USE epwcom,        ONLY : mixing_Plrn, init_plrn_wf, niterPlrn
83        USE epwcom,        ONLY : nkf1, nkf2, nkf3, nbndsub
84        USE io_global,     ONLY : stdout, ionode, meta_ionode_id
85        USE elph2,         ONLY : etf, ibndmin, ibndmax, nbndfst
86        USE elph2,         ONLY : nkqf, nkf, nqf, nqtotf, nktotf
87        USE elph2,         ONLY : xkf, xqf, wf, xkq, chw
88        USE mp_global,     ONLY : inter_pool_comm
89        USE mp_world,      ONLY : world_comm
90        USE cell_base,     ONLY : bg
91        USE mp,            ONLY : mp_sum, mp_bcast
92        USE poolgathering, ONLY : poolgather2
93        USE test_tools,    ONLY : para_write
94        USE wan2bloch,     ONLY : hamwan2bloch
95        USE ions_base,     ONLY : nat
96
97        IMPLICIT NONE
98
99        ! local variables
100        LOGICAL :: debug
101        INTEGER :: inu, iq, ik, ikk, jk, ibnd, jbnd, ikq, ik_global, iplrn, ierr
102        INTEGER :: iter, icount, ix, iy, iz, start_mode, ik_bm, idos, iatm
103
104        INTEGER, INTENT (IN) :: nrr_k, dims, ndegen_k(:,:,:) ! ! Added for polaron calculations by Chao Lian.
105        REAL(DP), INTENT (IN) :: irvec_r(3, nrr_k)
106
107        COMPLEX(DP),  ALLOCATABLE :: Bmat(:,:), Bmat_save(:,:)
108        COMPLEX(DP),  ALLOCATABLE :: eigvec_wan(:, :), dtau(:, :)
109        REAL(DP),     ALLOCATABLE :: rmat_tmp(:, :)
110
111        COMPLEX(KIND=dp) :: cufkk ( nbndsub, nbndsub ), cfac(nrr_k, dims, dims)
112        !! Rotation matrix, fine mesh, points k
113
114        REAL(dp):: estmteRt(nPlrn),  eigVal(nPlrn), esterr
115
116        REAL(KIND=dp) :: qcart(3), r0(3), xxk(3), xxq(3), prefac, norm
117        REAL(KIND=dp) :: ef
118
119        INTEGER :: band_pos, iqpg, ikpg, ikGamma, iqGamma
120        INTEGER :: nkf1_p, nkf2_p, nkf3_p, nbndsub_p, nPlrn_p, nktotf_p
121
122        REAL(DP) :: eb
123        REAL(DP) :: xkf_all(3, nktotf), xkf_all_tmp(3, nktotf*2)
124        REAL(DP) :: EPlrnTot, EPlrnElec, EPlrnPhon
125        REAL(DP) :: disK, disK_t, shift(3)
126
127        COMPLEX(DP) :: ctemp
128        REAL(DP)    :: rtemp
129        INTEGER     :: itemp, jtemp
130        INTEGER     :: dos_file, wan_func_file, bloch_func_file, bmat_file, dtau_file
131        !LOGICAL     :: SCF_run
132
133    END SUBROUTINE
134    SUBROUTINE plot_plrn_wf()
135    END SUBROUTINE
136END MODULE
137