Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 : !--------------------------------------------------------------------------------
7 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
8 : ! This file is part of FLEUR and available as free software under the conditions
9 : ! of the MIT license as expressed in the LICENSE file in more detail.
10 : !--------------------------------------------------------------------------------
11 : MODULE m_vis_xc
12 : USE m_juDFT
13 : use m_convol
14 : ! ******************************************************
15 : ! subroutine generates the exchange-correlation potential
16 : ! in the interstitial region c.l.fu
17 : ! including gradient corrections. t.a. 1996.
18 : ! ******************************************************
19 : CONTAINS
20 344 : SUBROUTINE vis_xc(stars,sym,cell,den,xcpot,input,noco,EnergyDen,kinED,vTot,vx,exc,vxc)
21 :
22 : ! ******************************************************
23 : ! instead of visxcor.f: the different exchange-correlation
24 : ! potentials defined through the key icorr are called through
25 : ! the driver subroutine vxcallg.f,for the energy density - excallg
26 : ! subroutines vectorized
27 : ! ** r.pentcheva 22.01.96
28 : ! *********************************************************
29 : ! in case of total = .true. calculates the ex-corr. energy
30 : ! density
31 : ! ** r.pentcheva 08.05.96
32 : ! ******************************************************************
33 : USE m_pw_tofrom_grid
34 : USE m_types
35 : USE m_types_xcpot_libxc
36 : USE m_libxc_postprocess_gga
37 : USE m_metagga
38 : IMPLICIT NONE
39 :
40 : CLASS(t_xcpot),INTENT(IN) :: xcpot
41 : TYPE(t_input),INTENT(IN) :: input
42 : TYPE(t_noco),INTENT(IN) :: noco
43 : TYPE(t_sym),INTENT(IN) :: sym
44 : TYPE(t_stars),INTENT(IN) :: stars
45 : TYPE(t_cell),INTENT(IN) :: cell
46 : TYPE(t_potden),INTENT(IN) :: den, EnergyDen
47 : TYPE(t_potden),INTENT(INOUT) :: vTot,vx,exc,vxc
48 : TYPE(t_kinED),INTENT(IN) ::kinED
49 :
50 344 : TYPE(t_gradients) :: grad
51 344 : REAL, ALLOCATABLE :: rho(:,:), ED_rs(:,:), vTot_rs(:,:)
52 : REAL, ALLOCATABLE :: rho_conv(:,:), ED_conv(:,:), vTot_conv(:,:)
53 344 : REAL, ALLOCATABLE :: v_x(:,:),v_xc(:,:),v_xc2(:,:),e_xc(:,:)
54 : INTEGER :: jspin, i, js
55 : LOGICAL :: perform_MetaGGA, l_libxc
56 :
57 344 : l_libxc=.FALSE.
58 :
59 : perform_MetaGGA = ALLOCATED(EnergyDen%mt) &
60 344 : .AND. (xcpot%exc_is_MetaGGA() .or. xcpot%vx_is_MetaGGA())
61 :
62 344 : call timestart("init_pw_grid")
63 344 : CALL init_pw_grid(stars,sym,cell,xcpot)
64 344 : call timestop("init_pw_grid")
65 :
66 : !Put the charge on the grid, in GGA case also calculate gradients
67 344 : call timestart("pw_to_grid")
68 344 : CALL pw_to_grid(xcpot%needs_grad(),input%jspins,noco%l_noco,stars,cell,den%pw,grad,xcpot,rho)
69 344 : call timestop("pw_to_grid")
70 :
71 1376 : ALLOCATE(v_xc,mold=rho)
72 1032 : ALLOCATE(v_xc2,mold=rho)
73 1032 : ALLOCATE(v_x,mold=rho)
74 :
75 344 : call timestart("apply_cutoffs")
76 344 : CALL xcpot%apply_cutoffs(1.E-6,rho,grad)
77 344 : call timestop("apply_cutoffs")
78 : #ifdef CPP_LIBXC
79 344 : if(perform_MetaGGA .and. kinED%set) then
80 0 : CALL xcpot%get_vxc(input%jspins,rho,v_xc, v_x,grad, kinEnergyDen_KS=kinED%is)
81 : else
82 344 : CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
83 : endif
84 : #else
85 : call timestart("get_vxc")
86 : CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
87 : call timestop("get_vxc")
88 : #endif
89 :
90 : SELECT TYPE(xcpot)
91 : TYPE IS (t_xcpot_libxc)
92 5 : l_libxc=.TRUE.
93 5 : IF (xcpot%needs_grad()) THEN
94 4 : CALL libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
95 4 : CALL libxc_postprocess_gga_pw(xcpot,stars,cell,v_x,grad)
96 : END IF
97 : END SELECT
98 :
99 : !IF (l_libxc.AND.xcpot%needs_grad()) THEN
100 : ! CALL save_npy('vxc_gga_ir_libxc.npy',v_xc)
101 : !ELSE IF (l_libxc.AND.(.NOT.xcpot%needs_grad())) THEN
102 : ! CALL save_npy('vxc_lda_ir_libxc.npy',v_xc)
103 : !ELSE IF ((.NOT.l_libxc).AND.xcpot%needs_grad()) THEN
104 : ! CALL save_npy('vxc_gga_ir_inbuild.npy',v_xc)
105 : !ELSE
106 : ! CALL save_npy('vxc_lda_ir_inbuild.npy',v_xc)
107 : !END IF
108 :
109 10148802 : v_xc2=v_xc
110 : !Put the potentials in rez. space.
111 344 : call timestart("pw_from_grid")
112 344 : CALL pw_from_grid(stars,v_xc,vTot%pw,vTot%pw_w)
113 344 : CALL pw_from_grid(stars,v_xc2,vxc%pw)
114 344 : CALL pw_from_grid(stars,v_x,vx%pw,vx%pw_w)
115 344 : call timestop("pw_from_grid")
116 :
117 : !calculate the ex.-cor energy density
118 344 : IF (ALLOCATED(exc%pw_w)) THEN
119 6386433 : ALLOCATE ( e_xc(SIZE(rho,1),1) ); e_xc=0.0
120 : #ifdef CPP_LIBXC
121 344 : IF(kinED%set) THEN
122 0 : CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, kinED%is, mt_call=.False.)
123 : ELSE
124 344 : CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, mt_call=.False.)
125 : ENDIF
126 :
127 : #else
128 : call timestart("get_exc")
129 : CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, mt_call=.False.)
130 : call timestop("get_exc")
131 : #endif
132 344 : call timestart("pw_from_grid")
133 344 : CALL pw_from_grid(stars,e_xc,exc%pw,exc%pw_w)
134 344 : call timestop("pw_from_grid")
135 : ENDIF
136 :
137 344 : call timestart("finish_pw_grid")
138 344 : CALL finish_pw_grid()
139 344 : call timestop("finish_pw_grid")
140 344 : END SUBROUTINE vis_xc
141 344 : END MODULE m_vis_xc
|
