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 : MODULE m_cdnsp
8 : USE m_juDFT
9 : ! *******************************************************
10 : ! sets up the starting density for the spin-polarized
11 : ! calculation from a paramagnetic density
12 : ! changed to suit both ferromagnetic and antiferro-
13 : ! magnetic case. changes only in mt-part - r.pentcheva Jan'96
14 : ! *******************************************************
15 : CONTAINS
16 1 : SUBROUTINE cdnsp(atoms,input,vacuum,sphhar,stars,sym,noco ,cell)
17 :
18 : USE m_intgr, ONLY : intgr3
19 : USE m_constants
20 : USE m_cdn_io
21 : USE m_types
22 : IMPLICIT NONE
23 : ! ..
24 : TYPE(t_stars),INTENT(IN) :: stars
25 : TYPE(t_vacuum),INTENT(IN) :: vacuum
26 : TYPE(t_atoms),INTENT(IN) :: atoms
27 : TYPE(t_sphhar),INTENT(IN) :: sphhar
28 : TYPE(t_input),INTENT(IN) :: input
29 : TYPE(t_sym),INTENT(IN) :: sym
30 : TYPE(t_noco),INTENT(IN) :: noco
31 :
32 : TYPE(t_cell),INTENT(IN) :: cell
33 :
34 :
35 : ! local type instances
36 1 : TYPE(t_potden) :: den
37 : TYPE(t_input) ::input_jsp
38 : ! .. Local Scalars ..
39 : REAL dummy,pp,qtot1,qtot2,spmtot,qval,sfp,fermiEnergyTemp,tempDistance
40 : INTEGER i,ivac,j,k,lh,n,na,jsp_new,i_u
41 : INTEGER ios, archiveType
42 : LOGICAL n_exist,l_qfix
43 : ! ..
44 : ! .. Local Arrays ..
45 1 : REAL p(atoms%ntype)
46 1 : REAL rhoc(atoms%jmtd,atoms%ntype,input%jspins)
47 1 : REAL tec(atoms%ntype,input%jspins),qintc(atoms%ntype,input%jspins)
48 1 : CHARACTER(len=140), ALLOCATABLE :: clines(:)
49 : CHARACTER(len=140) :: lineread
50 : ! ..
51 1 : sfp = 2 * SQRT(pi_const)
52 : !sphhar%nlhd = MAXVAL(sphhar%nlh(:))
53 :
54 1 : IF (input%jspins/=2) CALL juDFT_error("cdnsp: set jspins = 2!", calledby ="cdnsp")
55 :
56 1 : CALL den%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
57 1 : input_jsp=input
58 1 : input_jsp%jspins=1
59 1 : CALL readCoreDensity(input_jsp,atoms,rhoc,tec,qintc)
60 :
61 : CALL readDensity(stars,noco,vacuum,atoms,cell,sphhar,input_jsp,sym ,CDN_ARCHIVE_TYPE_CDN1_const,&
62 1 : CDN_INPUT_DEN_const,0,fermiEnergyTemp,tempDistance,l_qfix,den)
63 :
64 1 : qval = 0.
65 : !
66 : ! ---> set jspins=2
67 1 : jsp_new = 2
68 : !
69 2 : DO n = 1,atoms%ntype
70 1 : na = atoms%firstAtom(n)
71 926 : DO j = 1,atoms%jri(n)
72 926 : den%mt(j,0,n,1) = den%mt(j,0,n,1) - rhoc(j,n,1)/sfp
73 : ENDDO
74 1 : CALL intgr3(den%mt(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qval)
75 1 : p(n) = (atoms%bmu(n)+sfp*qval)/ (2.*sfp*qval)
76 1 : pp = 1.0 - p(n)
77 926 : DO j = 1,atoms%jri(n)
78 925 : den%mt(j,0,n,jsp_new) = pp*den%mt(j,0,n,1) + rhoc(j,n,1)/ (2.*sfp)
79 926 : den%mt(j,0,n,1) = p(n)*den%mt(j,0,n,1) + rhoc(j,n,1)/ (2.*sfp)
80 : ENDDO
81 123 : DO lh = 1,sphhar%nlh(sym%ntypsy(na))
82 111121 : DO j = 1,atoms%jri(n)
83 111000 : den%mt(j,lh,n,jsp_new) = pp*den%mt(j,lh,n,1)
84 111120 : den%mt(j,lh,n,1) = p(n)*den%mt(j,lh,n,1)
85 : ENDDO
86 : ENDDO
87 : ENDDO
88 9842 : DO k = 1,stars%ng3
89 9841 : den%pw(k,jsp_new) = 0.5 * den%pw(k,1)
90 9842 : den%pw(k,1) = den%pw(k,jsp_new)
91 : ENDDO
92 1 : IF (input%film) THEN
93 0 : DO ivac = 1,vacuum%nvac
94 0 : DO j = 1, vacuum%nmz
95 0 : den%vac(j,1,ivac,jsp_new) = 0.5 * den%vac(j,1,ivac,1)
96 0 : den%vac(j,1,ivac,1) = den%vac(j,1,ivac,jsp_new)
97 : ENDDO
98 0 : DO k = 2, stars%ng2
99 0 : DO j = 1,vacuum%nmzxy
100 0 : den%vac(j,k,ivac,jsp_new) = 0.5 * den%vac(j,k,ivac,1)
101 0 : den%vac(j,k,ivac,1) = den%vac(j,k,ivac,jsp_new)
102 : ENDDO
103 : ENDDO
104 : ENDDO
105 : ENDIF
106 :
107 : ! LDA + U
108 1 : IF (atoms%n_u.GT.0) THEN
109 0 : DO i_u = 1, atoms%n_u
110 0 : n = atoms%lda_u(i_u)%atomType
111 0 : pp = 1.0 - p(n)
112 0 : den%mmpMat(:,:,i_u,jsp_new) = pp * den%mmpMat(:,:,i_u,1)
113 0 : den%mmpMat(:,:,i_u,1) = p(n) * den%mmpMat(:,:,i_u,1)
114 : END DO
115 : END IF
116 :
117 927 : rhoc(:,:,1) = 0.5 * rhoc(:,:,1)
118 927 : rhoc(:,:,jsp_new) = rhoc(:,:,1)
119 2 : tec(:,1) = 0.5 * tec(:,1)
120 2 : tec(:,jsp_new) = tec(:,1)
121 2 : qintc(:,1) = 0.5 * qintc(:,1)
122 2 : qintc(:,jsp_new) = 0.5 * qintc(:,1)
123 :
124 1 : CALL writeCoreDensity(input,atoms,rhoc,tec,qintc)
125 :
126 : ! ----> write the spin-polarized density
127 : CALL writeDensity(stars,noco,vacuum,atoms,cell,sphhar,input,sym ,CDN_ARCHIVE_TYPE_CDN1_const,&
128 1 : CDN_INPUT_DEN_const,0,-1.0,0.0,-1.0,-1.0,.FALSE.,den)
129 : !
130 : ! -----> This part is only used for testing th e magnetic moment in
131 : ! -----> each sphere
132 : !
133 2 : DO n = 1,atoms%ntype
134 : qtot1=0.00
135 : qtot2=0.00
136 1 : CALL intgr3(den%mt(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qtot1)
137 1 : CALL intgr3(den%mt(1,0,n,jsp_new),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qtot2)
138 1 : spmtot=sfp*(qtot1-qtot2)
139 2 : WRITE (oUnit,'('' moment in sphere '',2x,'':'',f8.4)') spmtot
140 : ENDDO
141 :
142 : !---> read enpara and then double it
143 1 : INQUIRE(file='enpara',exist=n_exist)
144 1 : IF (n_exist) THEN
145 0 : OPEN(40,file ='enpara',status='old',form='formatted')
146 0 : REWIND 40
147 0 : n = 0
148 0 : DO
149 0 : READ (40,'(a)',iostat = ios) lineread
150 0 : IF (ios/=0) EXIT
151 0 : n = n+1
152 : ENDDO
153 :
154 0 : ALLOCATE (clines(n))
155 :
156 0 : REWIND 40
157 0 : DO i = 1,n
158 0 : READ (40,'(a)') clines(i)
159 : ENDDO
160 :
161 0 : REWIND 40
162 0 : DO i = 1,n
163 0 : WRITE (40,'(a)') TRIM(clines(i))
164 : ENDDO
165 0 : DO i = 1,n
166 0 : WRITE (40,'(a)') TRIM(clines(i))
167 : ENDDO
168 :
169 0 : DEALLOCATE (clines)
170 0 : CLOSE(40)
171 : ENDIF
172 : ! !
173 : ! ! for lda+U: flip n-matrix
174 : ! !
175 : ! IF (atoms%n_u.GT.0) THEN
176 : ! INQUIRE (file='n_mmp_mat',exist=n_exist)
177 : ! IF (n_exist) THEN
178 : ! OPEN (69,file='n_mmp_mat',status='old',form='formatted')
179 : ! REWIND 69
180 : !
181 : ! n=0
182 : ! DO
183 : ! READ (69,'(a)',iostat=ios) lineread
184 : ! IF (ios.NE.0) EXIT
185 : ! n = n+1
186 : ! ENDDO
187 : ! ALLOCATE (clines(n))
188 : ! REWIND 69
189 : ! DO i=1,n
190 : ! WRITE (69,'(a)') TRIM(clines(i))
191 : ! ENDDO
192 : ! DO i=1,n
193 : ! WRITE (69,'(a)') TRIM(clines(i))
194 : ! ENDDO
195 : ! DEALLOCATE (clines)
196 : !
197 : ! CLOSE(69)
198 : ! ENDIF
199 : ! ENDIF
200 :
201 :
202 1 : END SUBROUTINE cdnsp
203 : END MODULE m_cdnsp
|
