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 : MODULE m_vgen
7 : USE m_juDFT
8 :
9 : CONTAINS
10 :
11 688 : SUBROUTINE vgen(hybdat,field,input,xcpot,atoms,sphhar,stars,vacuum,sym,juphon,&
12 : cell ,sliceplot,fmpi,results,noco,nococonv,EnergyDen,den,vTot,vx,vCoul,vxc,exc)
13 : !--------------------------------------------------------------------------
14 : ! FLAPW potential generator (main routine)
15 : !
16 : ! The full potential is generated by the following main steps:
17 : ! a) Generation of Coulomb potential from the total density.
18 : ! b) Copying of VCoul to both spins.
19 : ! c) Generation of XC potential.
20 : ! d) Finalizations including e.g. rescaling and rotations.
21 : !
22 : ! In results we store:
23 : ! TE_VCOUL : charge density-coulomb potential integral
24 : ! TE_VEFF : charge density-effective potential integral
25 : ! TE_EXC : charge density-xc-energy density integral
26 : !
27 : !--------------------------------------------------------------------------
28 :
29 : USE m_types
30 : USE m_constants
31 : USE m_rotate_int_den_tofrom_local
32 : USE m_bfield
33 : USE m_vgen_coulomb
34 : USE m_vgen_xcpot
35 : USE m_vgen_finalize
36 : USE m_rotate_mt_den_tofrom_local
37 : USE m_magnMomFromDen
38 : USE m_force_sf ! Klueppelberg (force level 3)
39 : USE m_fleur_vdW
40 :
41 : IMPLICIT NONE
42 :
43 : TYPE(t_results), INTENT(INOUT) :: results
44 : CLASS(t_xcpot), INTENT(IN) :: xcpot
45 : TYPE(t_hybdat), INTENT(IN) :: hybdat
46 : TYPE(t_mpi), INTENT(IN) :: fmpi
47 :
48 : TYPE(t_sliceplot), INTENT(IN) :: sliceplot
49 : TYPE(t_input), INTENT(IN) :: input
50 : TYPE(t_field), INTENT(IN) :: field
51 : TYPE(t_vacuum), INTENT(IN) :: vacuum
52 : TYPE(t_noco), INTENT(IN) :: noco
53 : TYPE(t_nococonv), INTENT(INOUT) :: nococonv
54 : TYPE(t_sym), INTENT(IN) :: sym
55 : TYPE(t_juphon), INTENT(IN) :: juphon
56 : TYPE(t_stars), INTENT(IN) :: stars
57 : TYPE(t_cell), INTENT(IN) :: cell
58 : TYPE(t_sphhar), INTENT(IN) :: sphhar
59 : TYPE(t_atoms), INTENT(IN) :: atoms
60 : TYPE(t_potden), INTENT(IN) :: EnergyDen
61 : TYPE(t_potden), INTENT(INOUT) :: den
62 : TYPE(t_potden), INTENT(INOUT) :: vTot, vx, vCoul, vxc, exc
63 :
64 688 : TYPE(t_potden) :: workden, denRot
65 :
66 : INTEGER :: i, js
67 688 : REAL :: b(3,atoms%ntype), dummy1(atoms%ntype), dummy2(atoms%ntype)
68 : complex :: sigma_loc(2)
69 :
70 688 : IF (fmpi%irank == 0) THEN
71 344 : IF (noco%l_sourceFree) THEN
72 1 : CALL magnMomFromDen(input,atoms,noco,den,b,dummy1,dummy2)
73 3 : DO i=1,atoms%ntype
74 3 : WRITE (oUnit,8025) i,b(1,i),b(2,i),b(3,i),SQRT(b(1,i)**2+b(2,i)**2+b(3,i)**2)
75 : 8025 FORMAT(2x,'Magmom before SF [local frame, atom ',i2,']: ','mx=',f9.5,' my=',f9.5,' mz=',f9.5,' |m|=',f9.5)
76 : END DO
77 : END IF
78 : END IF
79 :
80 688 : IF (fmpi%irank==0) WRITE (oUnit,FMT=8000)
81 : 8000 FORMAT (/,/,t10,' p o t e n t i a l g e n e r a t o r',/)
82 :
83 688 : CALL vTot%resetPotDen()
84 688 : CALL vCoul%resetPotDen()
85 688 : CALL vx%resetPotDen()
86 688 : CALL vxc%resetPotDen()
87 688 : CALL exc%resetPotDen()
88 :
89 2752 : ALLOCATE(vx%pw_w,mold=vTot%pw)
90 3085170 : vx%pw_w = 0.0
91 2064 : ALLOCATE(vxc%pw_w,mold=vTot%pw)
92 3085170 : vxc%pw_w = 0.0
93 688 : CALL exc%init(stars, atoms, sphhar, vacuum, noco, 1, 1) !one spin only
94 1550624 : ALLOCATE (exc%pw_w(stars%ng3, 1)); exc%pw_w = 0.0
95 :
96 : #ifndef CPP_OLDINTEL
97 2752 : ALLOCATE(vTot%pw_w,mold=vTot%pw)
98 : #else
99 : ALLOCATE( vTot%pw_w(size(vTot%pw,1),size(vTot%pw,2)))
100 : #endif
101 :
102 2752 : ALLOCATE(vCoul%pw_w(SIZE(vCoul%pw,1),size(vCoul%pw,2)))
103 3085170 : vCoul%pw_w = CMPLX(0.0,0.0)
104 :
105 9350 : results%force=0.0
106 :
107 688 : CALL workDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,0)
108 :
109 : ! a)
110 : ! Sum up both spins in den into workden:
111 688 : CALL den%sum_both_spin(workden)
112 688 : sigma_loc = cmplx(0.0,0.0)
113 688 : CALL vgen_coulomb(1,fmpi ,input,field,vacuum,sym,juphon,stars,cell,sphhar,atoms,.FALSE.,workden,vCoul,sigma_loc,results)
114 :
115 : !vdW Potential
116 19914846 : workden%vac = CMPLX(0.0,0.0)
117 688 : IF (input%vdw>0) CALL fleur_vdW_mCallsen(fmpi,atoms,sphhar,stars,input,cell,sym ,juphon,vacuum,results,workden,vCoul%pw(:,1),vCoul%mt)
118 :
119 : ! b)
120 688 : CALL vCoul%copy_both_spin(vTot)
121 23737776 : vCoul%mt(:,:,:,input%jspins)=vCoul%mt(:,:,:,1)
122 :
123 : ! c)
124 688 : IF (noco%l_noco) THEN
125 192 : CALL denRot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,0)
126 192 : denRot=den
127 192 : CALL rotate_int_den_to_local(sym,stars,atoms,sphhar,vacuum,cell,input,noco ,denRot)
128 460 : IF (any(noco%l_unrestrictMT)) CALL rotate_mt_den_to_local(atoms,sphhar,sym,noco,denrot)
129 : END IF
130 :
131 : CALL vgen_xcpot(hybdat,input,xcpot,atoms,sphhar,stars,vacuum,sym,&
132 688 : cell,fmpi,noco,den,denRot,EnergyDen,vTot,vx,vxc,exc,results=results)
133 :
134 688 : CALL bfield(input,stars,noco,atoms,field,vTot)
135 :
136 :
137 :
138 : ! d)
139 : ! TODO: Check if this is needed for more potentials as well!
140 688 : CALL vgen_finalize(fmpi ,field,cell,atoms,stars,vacuum,sym,juphon,noco,nococonv,input,xcpot,sphhar,vTot,vCoul,denRot,sliceplot)
141 : !DEALLOCATE(vcoul%pw_w)
142 :
143 688 : CALL vTot%distribute(fmpi%mpi_comm)
144 688 : CALL vCoul%distribute(fmpi%mpi_comm)
145 688 : CALL vx%distribute(fmpi%mpi_comm)
146 688 : CALL vxc%distribute(fmpi%mpi_comm)
147 688 : CALL exc%distribute(fmpi%mpi_comm)
148 :
149 : ! Klueppelberg (force level 3)
150 688 : IF (input%l_f.AND.(input%f_level.GE.3).AND.(fmpi%irank.EQ.0)) THEN
151 2 : DO js = 1,input%jspins
152 2 : CALL force_sf_is(atoms,stars,sym,js,cell,den%pw,vTot%pw,exc%pw(:,1),vxc%pw)
153 : END DO
154 :
155 : END IF
156 :
157 688 : END SUBROUTINE vgen
158 :
159 : END MODULE m_vgen
|
