Merge lp:~nickpapior/siesta/4.1-phases into lp:siesta/4.1
- 4.1-phases
- Merge into rel-4.1
Proposed by
Nick Papior
Status: | Merged |
---|---|
Merged at revision: | 894 |
Proposed branch: | lp:~nickpapior/siesta/4.1-phases |
Merge into: | lp:siesta/4.1 |
Diff against target: |
548 lines (+97/-129) (has conflicts) 8 files modified
Src/pdos2g.F (+8/-15) Src/pdos2k.F (+24/-30) Src/pdos3g.F (+6/-14) Src/pdos3k.F (+23/-29) Src/pdosg.F (+2/-3) Src/pdosk.F (+15/-17) Src/pdoskp.F (+15/-21) version.info (+4/-0) Text conflict in version.info |
To merge this branch: | bzr merge lp:~nickpapior/siesta/4.1-phases |
Related bugs: |
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Alberto Garcia | Pending | ||
Review via email: mp+343468@code.launchpad.net |
Commit message
Clarified phase usages in pdos codes.
Now comments explain why the pdos*k routines used a different sign in the S(k) generation when performing the matrix multiplications.
I.e. this branch introduces nothing but clarified code and slight performance increase due to removal of a small array and lots of copying.
Description of the change
To post a comment you must log in.
lp:~nickpapior/siesta/4.1-phases
updated
- 895. By Nick Papior
-
Amended pdoskp for the details outlined in the previous two commits
Now the phases are well explained in all pdos routines.
Revision history for this message
Alberto Garcia (albertog) wrote : | # |
Preview Diff
[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1 | === modified file 'Src/pdos2g.F' | |||
2 | --- Src/pdos2g.F 2017-09-27 13:56:46 +0000 | |||
3 | +++ Src/pdos2g.F 2018-04-18 08:41:10 +0000 | |||
4 | @@ -44,7 +44,7 @@ | |||
5 | 44 | C **** AUXILIARY ***************************************************** | 44 | C **** AUXILIARY ***************************************************** |
6 | 45 | C real*8 haux(nuo,nuo) : Auxiliary space for the hamiltonian matrix | 45 | C real*8 haux(nuo,nuo) : Auxiliary space for the hamiltonian matrix |
7 | 46 | C real*8 saux(nuo,nuo) : Auxiliary space for the overlap matrix | 46 | C real*8 saux(nuo,nuo) : Auxiliary space for the overlap matrix |
9 | 47 | C real*8 psi(nuo,nuo) : Auxiliary space for the eigenvectors | 47 | C complex*16 psi(2,nuo,nuo) : Auxiliary space for the eigenvectors |
10 | 48 | C **** OUTPUT ******************************************************** | 48 | C **** OUTPUT ******************************************************** |
11 | 49 | C real*8 dtot(nhist,4) : Total density of states | 49 | C real*8 dtot(nhist,4) : Total density of states |
12 | 50 | C real*8 dpr(nhist,nuo,4): Proyected density of states | 50 | C real*8 dpr(nhist,nuo,4): Proyected density of states |
13 | @@ -71,10 +71,11 @@ | |||
14 | 71 | 71 | ||
15 | 72 | real(dp) | 72 | real(dp) |
16 | 73 | . H(maxnh,4), S(maxnh), E1, E2, sigma, eo(maxo*2), | 73 | . H(maxnh,4), S(maxnh), E1, E2, sigma, eo(maxo*2), |
21 | 74 | . psi(2,2,nuotot,2*nuo), dtot(nhist,4), dpr(nhist,nuotot,4) | 74 | . dtot(nhist,4), dpr(nhist,nuotot,4) |
22 | 75 | 75 | complex(dp), target :: psi(2,nuotot,2*nuo) | |
23 | 76 | complex(dp) | 76 | |
24 | 77 | . Haux(2,nuotot,2,nuo), Saux(2,nuotot,2,nuo), caux(2,nuotot) | 77 | complex(dp) Haux(2,nuotot,2,nuo), Saux(2,nuotot,2,nuo) |
25 | 78 | complex(dp), pointer :: caux(:,:) | ||
26 | 78 | external cdiag | 79 | external cdiag |
27 | 79 | 80 | ||
28 | 80 | C Internal variables --------------------------------------------------- | 81 | C Internal variables --------------------------------------------------- |
29 | @@ -181,11 +182,7 @@ | |||
30 | 181 | diff = (ener - eo(ibandg))**2 / (sigma ** 2) | 182 | diff = (ener - eo(ibandg))**2 / (sigma ** 2) |
31 | 182 | if (diff .gt. 15.0d0) cycle | 183 | if (diff .gt. 15.0d0) cycle |
32 | 183 | gauss = exp(-diff) | 184 | gauss = exp(-diff) |
38 | 184 | caux(:,:) = dcmplx(0.0_dp,0.0_dp) | 185 | caux => psi(:,:,iband) ! c_{up,j}, c_{down,j} |
34 | 185 | do j=1,nuotot | ||
35 | 186 | caux(1,j) = dcmplx(psi(1,1,j,iband),psi(2,1,j,iband)) ! c_{j,up) | ||
36 | 187 | caux(2,j) = dcmplx(psi(1,2,j,iband),psi(2,2,j,iband)) ! c_{j,down) | ||
37 | 188 | enddo | ||
39 | 189 | do jo = 1, Bnuo | 186 | do jo = 1, Bnuo |
40 | 190 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) | 187 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) |
41 | 191 | do io = 1, nuotot | 188 | do io = 1, nuotot |
42 | @@ -218,11 +215,7 @@ | |||
43 | 218 | diff = (ener - eo(iband))**2 / (sigma ** 2) | 215 | diff = (ener - eo(iband))**2 / (sigma ** 2) |
44 | 219 | if (diff .gt. 15.0d0) cycle | 216 | if (diff .gt. 15.0d0) cycle |
45 | 220 | gauss = exp(-diff) | 217 | gauss = exp(-diff) |
51 | 221 | caux(:,:) = dcmplx(0.0_dp,0.0_dp) | 218 | caux => psi(:,:,iband) ! c_{up,j}, c_{down,j} |
47 | 222 | do j=1,nuotot | ||
48 | 223 | caux(1,j) = dcmplx(psi(1,1,j,iband),psi(2,1,j,iband)) ! c_{j,up) | ||
49 | 224 | caux(2,j) = dcmplx(psi(1,2,j,iband),psi(2,2,j,iband)) ! c_{j,down) | ||
50 | 225 | enddo | ||
52 | 226 | do jo = 1, nuotot | 219 | do jo = 1, nuotot |
53 | 227 | do io = 1, nuotot | 220 | do io = 1, nuotot |
54 | 228 | rpipj = dreal(caux(1,io)*dconjg(caux(1,jo)))*gauss | 221 | rpipj = dreal(caux(1,io)*dconjg(caux(1,jo)))*gauss |
55 | 229 | 222 | ||
56 | === modified file 'Src/pdos2k.F' | |||
57 | --- Src/pdos2k.F 2017-09-27 13:56:46 +0000 | |||
58 | +++ Src/pdos2k.F 2018-04-18 08:41:10 +0000 | |||
59 | @@ -48,7 +48,7 @@ | |||
60 | 48 | C **** AUXILIARY ***************************************************** | 48 | C **** AUXILIARY ***************************************************** |
61 | 49 | C REAL*8 HAUX(2,NUO,NUO) : Auxiliary space for the hamiltonian matrix | 49 | C REAL*8 HAUX(2,NUO,NUO) : Auxiliary space for the hamiltonian matrix |
62 | 50 | C REAL*8 SAUX(2,NUO,NUO) : Auxiliary space for the overlap matrix | 50 | C REAL*8 SAUX(2,NUO,NUO) : Auxiliary space for the overlap matrix |
64 | 51 | C REAL*8 PSI(2,NUO,NUO) : Auxiliary space for the eigenvectors | 51 | C COMPLEX*16 PSI(2,NUO,NUO) : Auxiliary space for the eigenvectors |
65 | 52 | C **** OUTPUT ******************************************************** | 52 | C **** OUTPUT ******************************************************** |
66 | 53 | C REAL*8 DTOT(NHIST,4) : Total density of states | 53 | C REAL*8 DTOT(NHIST,4) : Total density of states |
67 | 54 | C REAL*8 DPR(NHIST,NUO,4): Proyected density of states | 54 | C REAL*8 DPR(NHIST,NUO,4): Proyected density of states |
68 | @@ -75,11 +75,11 @@ | |||
69 | 75 | real(dp) | 75 | real(dp) |
70 | 76 | . H(MAXNH,4), S(MAXNH), E1, E2, SIGMA, | 76 | . H(MAXNH,4), S(MAXNH), E1, E2, SIGMA, |
71 | 77 | . XIJ(3,MAXNH), KPOINT(3,NK), EO(MAXO*2,NK), | 77 | . XIJ(3,MAXNH), KPOINT(3,NK), EO(MAXO*2,NK), |
74 | 78 | . DTOT(NHIST,4), DPR(NHIST,NUOTOT,4), WK(NK), | 78 | . DTOT(NHIST,4), DPR(NHIST,NUOTOT,4), WK(NK) |
75 | 79 | . psi(2,2,nuotot,2*nuo) | 79 | complex(dp), target :: psi(2,nuotot,2*nuo) |
76 | 80 | 80 | ||
79 | 81 | complex(dp) Haux(2,nuotot,2,nuo), Saux(2,nuotot,2,nuo), | 81 | complex(dp) Haux(2,nuotot,2,nuo), Saux(2,nuotot,2,nuo) |
80 | 82 | . caux(2,nuotot) | 82 | complex(dp), pointer :: caux(:,:) |
81 | 83 | 83 | ||
82 | 84 | complex(dp) kphs | 84 | complex(dp) kphs |
83 | 85 | 85 | ||
84 | @@ -94,8 +94,7 @@ | |||
85 | 94 | real(dp) | 94 | real(dp) |
86 | 95 | . KXIJ, CKXIJ, SKXIJ, DELTA, ENER, DIFF, GAUSS, NORM, WKSUM | 95 | . KXIJ, CKXIJ, SKXIJ, DELTA, ENER, DIFF, GAUSS, NORM, WKSUM |
87 | 96 | 96 | ||
90 | 97 | complex(dp) | 97 | complex(dp) :: D11, D12, D22 |
89 | 98 | . D11, D12, D21, D22 | ||
91 | 99 | 98 | ||
92 | 100 | complex(dp), pointer :: Spr(:,:) => null() | 99 | complex(dp), pointer :: Spr(:,:) => null() |
93 | 101 | 100 | ||
94 | @@ -127,7 +126,7 @@ | |||
95 | 127 | kxij = kpoint(1,ik) * xij(1,ind) + | 126 | kxij = kpoint(1,ik) * xij(1,ind) + |
96 | 128 | . kpoint(2,ik) * xij(2,ind) + | 127 | . kpoint(2,ik) * xij(2,ind) + |
97 | 129 | . kpoint(3,ik) * xij(3,ind) | 128 | . kpoint(3,ik) * xij(3,ind) |
99 | 130 | kphs = cdexp(dcmplx(0.0_dp, -1.0_dp)*kxij) | 129 | kphs = cdexp(dcmplx(0.0_dp, -kxij)) |
100 | 131 | 130 | ||
101 | 132 | Saux(1,juo,1,iuo) = Saux(1,juo,1,iuo) + S(ind) * kphs | 131 | Saux(1,juo,1,iuo) = Saux(1,juo,1,iuo) + S(ind) * kphs |
102 | 133 | Saux(2,juo,2,iuo) = Saux(2,juo,2,iuo) + S(ind) * kphs | 132 | Saux(2,juo,2,iuo) = Saux(2,juo,2,iuo) + S(ind) * kphs |
103 | @@ -159,7 +158,7 @@ | |||
104 | 159 | kxij = kpoint(1,ik) * xij(1,ind) + | 158 | kxij = kpoint(1,ik) * xij(1,ind) + |
105 | 160 | . kpoint(2,ik) * xij(2,ind) + | 159 | . kpoint(2,ik) * xij(2,ind) + |
106 | 161 | . kpoint(3,ik) * xij(3,ind) | 160 | . kpoint(3,ik) * xij(3,ind) |
108 | 162 | kphs = cdexp(dcmplx(0.0_dp, -1.0_dp)*kxij) | 161 | kphs = cdexp(dcmplx(0.0_dp, -kxij)) |
109 | 163 | 162 | ||
110 | 164 | Saux(1,juo,1,iuo) = Saux(1,juo,1,iuo) + S(ind) * kphs | 163 | Saux(1,juo,1,iuo) = Saux(1,juo,1,iuo) + S(ind) * kphs |
111 | 165 | Saux(2,juo,2,iuo) = Saux(2,juo,2,iuo) + S(ind) * kphs | 164 | Saux(2,juo,2,iuo) = Saux(2,juo,2,iuo) + S(ind) * kphs |
112 | @@ -188,7 +187,10 @@ | |||
113 | 188 | kxij = kpoint(1,ik) * xij(1,ind) + | 187 | kxij = kpoint(1,ik) * xij(1,ind) + |
114 | 189 | . kpoint(2,ik) * xij(2,ind) + | 188 | . kpoint(2,ik) * xij(2,ind) + |
115 | 190 | . kpoint(3,ik) * xij(3,ind) | 189 | . kpoint(3,ik) * xij(3,ind) |
117 | 191 | kphs = cdexp(dcmplx(0.0_dp, 1.0_dp)*kxij) | 190 | ! Since we are doing element wise multiplications (and not dot-products) |
118 | 191 | ! we might as well setup the transpose S(k)^T == S(-k) because this will | ||
119 | 192 | ! mean that we can do a simpler multiplication further down | ||
120 | 193 | kphs = cdexp(dcmplx(0.0_dp, kxij)) | ||
121 | 192 | Spr(juo,iuo) = Spr(juo,iuo) + S(ind) * kphs | 194 | Spr(juo,iuo) = Spr(juo,iuo) + S(ind) * kphs |
122 | 193 | enddo | 195 | enddo |
123 | 194 | enddo | 196 | enddo |
124 | @@ -225,23 +227,19 @@ | |||
125 | 225 | ibandg = ibandg * 2 - mod(iband, 2) | 227 | ibandg = ibandg * 2 - mod(iband, 2) |
126 | 226 | diff = (ener - eo(ibandg,ik))**2 / (sigma ** 2) | 228 | diff = (ener - eo(ibandg,ik))**2 / (sigma ** 2) |
127 | 227 | if (diff .gt. 15.0d0) cycle | 229 | if (diff .gt. 15.0d0) cycle |
134 | 228 | gauss = exp(-diff) | 230 | gauss = exp(-diff) * wk(ik) |
135 | 229 | caux(:,:) = dcmplx(0.0_dp,0.0_dp) | 231 | caux => psi(:,:,iband) ! c_{j,up), c_{j,down} |
130 | 230 | do j=1,nuotot | ||
131 | 231 | caux(1,j) = dcmplx(psi(1,1,j,iband),psi(2,1,j,iband)) ! c_{j,up) | ||
132 | 232 | caux(2,j) = dcmplx(psi(1,2,j,iband),psi(2,2,j,iband)) ! c_{j,down) | ||
133 | 233 | enddo | ||
136 | 234 | do jo = 1, Bnuo | 232 | do jo = 1, Bnuo |
137 | 235 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) | 233 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) |
138 | 236 | do io = 1, nuotot | 234 | do io = 1, nuotot |
139 | 237 | D11 = caux(1,io) * dconjg(caux(1,juo)) * Sloc(io,jo) | 235 | D11 = caux(1,io) * dconjg(caux(1,juo)) * Sloc(io,jo) |
140 | 238 | D22 = caux(2,io) * dconjg(caux(2,juo)) * Sloc(io,jo) | 236 | D22 = caux(2,io) * dconjg(caux(2,juo)) * Sloc(io,jo) |
141 | 239 | D12 = caux(1,io) * dconjg(caux(2,juo)) * Sloc(io,jo) | 237 | D12 = caux(1,io) * dconjg(caux(2,juo)) * Sloc(io,jo) |
143 | 240 | D21 = caux(2,io) * dconjg(caux(1,juo)) * Sloc(io,jo) | 238 | !D21 = caux(2,io) * dconjg(caux(1,juo)) * Sloc(io,jo) |
144 | 241 | 239 | ||
148 | 242 | D11 = gauss*wk(ik)*D11 | 240 | D11 = gauss*D11 |
149 | 243 | D22 = gauss*wk(ik)*D22 | 241 | D22 = gauss*D22 |
150 | 244 | D12 = gauss*wk(ik)*D12 | 242 | D12 = gauss*D12 |
151 | 245 | 243 | ||
152 | 246 | dpr(ihist,juo,1) = dpr(ihist,juo,1) + dreal(D11) | 244 | dpr(ihist,juo,1) = dpr(ihist,juo,1) + dreal(D11) |
153 | 247 | dpr(ihist,juo,2) = dpr(ihist,juo,2) + dreal(D22) | 245 | dpr(ihist,juo,2) = dpr(ihist,juo,2) + dreal(D22) |
154 | @@ -265,22 +263,18 @@ | |||
155 | 265 | do iband = 1, nuo*2 | 263 | do iband = 1, nuo*2 |
156 | 266 | diff = (ener - eo(iband,ik))**2 / (sigma ** 2) | 264 | diff = (ener - eo(iband,ik))**2 / (sigma ** 2) |
157 | 267 | if (diff .gt. 15.0d0) cycle | 265 | if (diff .gt. 15.0d0) cycle |
164 | 268 | gauss = exp(-diff) | 266 | gauss = exp(-diff) * wk(ik) |
165 | 269 | caux(:,:) = dcmplx(0.0_dp,0.0_dp) | 267 | caux => psi(:,:,iband) ! c_{up,j), c_{down,j} |
160 | 270 | do j=1,nuotot | ||
161 | 271 | caux(1,j) = dcmplx(psi(1,1,j,iband),psi(2,1,j,iband)) ! c_{j,up) | ||
162 | 272 | caux(2,j) = dcmplx(psi(1,2,j,iband),psi(2,2,j,iband)) ! c_{j,down) | ||
163 | 273 | enddo | ||
166 | 274 | do io = 1, nuotot | 268 | do io = 1, nuotot |
167 | 275 | do jo = 1, nuotot | 269 | do jo = 1, nuotot |
168 | 276 | D11 = caux(1,io) * dconjg(caux(1,jo)) * Spr(io,jo) | 270 | D11 = caux(1,io) * dconjg(caux(1,jo)) * Spr(io,jo) |
169 | 277 | D22 = caux(2,io) * dconjg(caux(2,jo)) * Spr(io,jo) | 271 | D22 = caux(2,io) * dconjg(caux(2,jo)) * Spr(io,jo) |
170 | 278 | D12 = caux(1,io) * dconjg(caux(2,jo)) * Spr(io,jo) | 272 | D12 = caux(1,io) * dconjg(caux(2,jo)) * Spr(io,jo) |
172 | 279 | D21 = caux(2,io) * dconjg(caux(1,jo)) * Spr(io,jo) | 273 | !D21 = caux(2,io) * dconjg(caux(1,jo)) * Spr(io,jo) |
173 | 280 | 274 | ||
177 | 281 | D11 = gauss*wk(ik)*D11 | 275 | D11 = gauss*D11 |
178 | 282 | D22 = gauss*wk(ik)*D22 | 276 | D22 = gauss*D22 |
179 | 283 | D12 = gauss*wk(ik)*D12 | 277 | D12 = gauss*D12 |
180 | 284 | 278 | ||
181 | 285 | dpr(ihist,jo,1) = dpr(ihist,jo,1) + dreal(D11) | 279 | dpr(ihist,jo,1) = dpr(ihist,jo,1) + dreal(D11) |
182 | 286 | dpr(ihist,jo,2) = dpr(ihist,jo,2) + dreal(D22) | 280 | dpr(ihist,jo,2) = dpr(ihist,jo,2) + dreal(D22) |
183 | 287 | 281 | ||
184 | === modified file 'Src/pdos3g.F' | |||
185 | --- Src/pdos3g.F 2017-09-27 13:56:46 +0000 | |||
186 | +++ Src/pdos3g.F 2018-04-18 08:41:10 +0000 | |||
187 | @@ -71,10 +71,10 @@ | |||
188 | 71 | 71 | ||
189 | 72 | real(dp) | 72 | real(dp) |
190 | 73 | . H(maxnh,8), S(maxnh), E1, E2, sigma, eo(maxo*2), | 73 | . H(maxnh,8), S(maxnh), E1, E2, sigma, eo(maxo*2), |
195 | 74 | . psi(2,2,nuotot,2*nuo), dtot(nhist,4), dpr(nhist,nuotot,4) | 74 | . dtot(nhist,4), dpr(nhist,nuotot,4) |
196 | 75 | 75 | complex(dp), target :: psi(2,nuotot,2*nuo) | |
197 | 76 | complex(dp) | 76 | complex(dp) Haux(2,nuotot,2,nuo), Saux(2,nuotot,2,nuo) |
198 | 77 | . Haux(2,nuotot,2,nuo), Saux(2,nuotot,2,nuo), caux(2,nuotot) | 77 | complex(dp), pointer :: caux(:,:) |
199 | 78 | external cdiag | 78 | external cdiag |
200 | 79 | 79 | ||
201 | 80 | C Internal variables --------------------------------------------------- | 80 | C Internal variables --------------------------------------------------- |
202 | @@ -180,11 +180,7 @@ | |||
203 | 180 | diff = (ener - eo(ibandg))**2 / (sigma ** 2) | 180 | diff = (ener - eo(ibandg))**2 / (sigma ** 2) |
204 | 181 | if (diff .gt. 15.0d0) cycle | 181 | if (diff .gt. 15.0d0) cycle |
205 | 182 | gauss = exp(-diff) | 182 | gauss = exp(-diff) |
211 | 183 | caux(:,:) = dcmplx(0.0_dp,0.0_dp) | 183 | caux => psi(:,:,iband) ! c_{up,j}, c_{down,j} |
207 | 184 | do j=1,nuotot | ||
208 | 185 | caux(1,j) = dcmplx(psi(1,1,j,iband),psi(2,1,j,iband)) ! c_{j,up) | ||
209 | 186 | caux(2,j) = dcmplx(psi(1,2,j,iband),psi(2,2,j,iband)) ! c_{j,down) | ||
210 | 187 | enddo | ||
212 | 188 | do jo = 1, Bnuo | 184 | do jo = 1, Bnuo |
213 | 189 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) | 185 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) |
214 | 190 | do io = 1, nuotot | 186 | do io = 1, nuotot |
215 | @@ -218,11 +214,7 @@ | |||
216 | 218 | diff = (ener - eo(iband))**2 / (sigma ** 2) | 214 | diff = (ener - eo(iband))**2 / (sigma ** 2) |
217 | 219 | if (diff .gt. 15.0d0) cycle | 215 | if (diff .gt. 15.0d0) cycle |
218 | 220 | gauss = exp(-diff) | 216 | gauss = exp(-diff) |
224 | 221 | caux(:,:) = dcmplx(0.0_dp,0.0_dp) | 217 | caux => psi(:,:,iband) ! c_{up,j}, c_{down,j} |
220 | 222 | do j=1,nuotot | ||
221 | 223 | caux(1,j) = dcmplx(psi(1,1,j,iband),psi(2,1,j,iband)) ! c_{j,up) | ||
222 | 224 | caux(2,j) = dcmplx(psi(1,2,j,iband),psi(2,2,j,iband)) ! c_{j,down) | ||
223 | 225 | enddo | ||
225 | 226 | do jo = 1, nuotot | 218 | do jo = 1, nuotot |
226 | 227 | do io = 1, nuotot | 219 | do io = 1, nuotot |
227 | 228 | rpipj = dreal(caux(1,io)*dconjg(caux(1,jo)))*gauss | 220 | rpipj = dreal(caux(1,io)*dconjg(caux(1,jo)))*gauss |
228 | 229 | 221 | ||
229 | === modified file 'Src/pdos3k.F' | |||
230 | --- Src/pdos3k.F 2017-09-27 13:56:46 +0000 | |||
231 | +++ Src/pdos3k.F 2018-04-18 08:41:10 +0000 | |||
232 | @@ -75,11 +75,11 @@ | |||
233 | 75 | real(dp) | 75 | real(dp) |
234 | 76 | . H(MAXNH,8), S(MAXNH), E1, E2, SIGMA, | 76 | . H(MAXNH,8), S(MAXNH), E1, E2, SIGMA, |
235 | 77 | . XIJ(3,MAXNH), KPOINT(3,NK), EO(MAXO*2,NK), | 77 | . XIJ(3,MAXNH), KPOINT(3,NK), EO(MAXO*2,NK), |
238 | 78 | . DTOT(NHIST,4), DPR(NHIST,NUOTOT,4), WK(NK), | 78 | . DTOT(NHIST,4), DPR(NHIST,NUOTOT,4), WK(NK) |
239 | 79 | . psi(2,2,nuotot,2*nuo) | 79 | complex(dp), target :: psi(2,nuotot,2*nuo) |
240 | 80 | 80 | ||
243 | 81 | complex(dp) Haux(2,nuotot,2,nuo), Saux(2,nuotot,2,nuo), | 81 | complex(dp) Haux(2,nuotot,2,nuo), Saux(2,nuotot,2,nuo) |
244 | 82 | . caux(2,nuotot) | 82 | complex(dp), pointer :: caux(:,:) |
245 | 83 | 83 | ||
246 | 84 | complex(dp) kphs | 84 | complex(dp) kphs |
247 | 85 | 85 | ||
248 | @@ -94,8 +94,7 @@ | |||
249 | 94 | real(dp) | 94 | real(dp) |
250 | 95 | . KXIJ, CKXIJ, SKXIJ, DELTA, ENER, DIFF, GAUSS, NORM, WKSUM | 95 | . KXIJ, CKXIJ, SKXIJ, DELTA, ENER, DIFF, GAUSS, NORM, WKSUM |
251 | 96 | 96 | ||
254 | 97 | complex(dp) | 97 | complex(dp) :: D11, D12, D22 |
253 | 98 | . D11, D12, D21, D22 | ||
255 | 99 | 98 | ||
256 | 100 | complex(dp), pointer :: Spr(:,:) => null() | 99 | complex(dp), pointer :: Spr(:,:) => null() |
257 | 101 | 100 | ||
258 | @@ -127,7 +126,7 @@ | |||
259 | 127 | kxij = kpoint(1,ik) * xij(1,ind) + | 126 | kxij = kpoint(1,ik) * xij(1,ind) + |
260 | 128 | . kpoint(2,ik) * xij(2,ind) + | 127 | . kpoint(2,ik) * xij(2,ind) + |
261 | 129 | . kpoint(3,ik) * xij(3,ind) | 128 | . kpoint(3,ik) * xij(3,ind) |
263 | 130 | kphs = cdexp(dcmplx(0.0_dp, -1.0_dp)*kxij) | 129 | kphs = cdexp(dcmplx(0.0_dp, -kxij)) |
264 | 131 | 130 | ||
265 | 132 | Saux(1,juo,1,iuo) = Saux(1,juo,1,iuo) + S(ind) * kphs | 131 | Saux(1,juo,1,iuo) = Saux(1,juo,1,iuo) + S(ind) * kphs |
266 | 133 | Saux(2,juo,2,iuo) = Saux(2,juo,2,iuo) + S(ind) * kphs | 132 | Saux(2,juo,2,iuo) = Saux(2,juo,2,iuo) + S(ind) * kphs |
267 | @@ -159,7 +158,7 @@ | |||
268 | 159 | kxij = kpoint(1,ik) * xij(1,ind) + | 158 | kxij = kpoint(1,ik) * xij(1,ind) + |
269 | 160 | . kpoint(2,ik) * xij(2,ind) + | 159 | . kpoint(2,ik) * xij(2,ind) + |
270 | 161 | . kpoint(3,ik) * xij(3,ind) | 160 | . kpoint(3,ik) * xij(3,ind) |
272 | 162 | kphs = cdexp(dcmplx(0.0_dp, -1.0_dp)*kxij) | 161 | kphs = cdexp(dcmplx(0.0_dp, -kxij)) |
273 | 163 | 162 | ||
274 | 164 | Saux(1,juo,1,iuo) = Saux(1,juo,1,iuo) + S(ind) * kphs | 163 | Saux(1,juo,1,iuo) = Saux(1,juo,1,iuo) + S(ind) * kphs |
275 | 165 | Saux(2,juo,2,iuo) = Saux(2,juo,2,iuo) + S(ind) * kphs | 164 | Saux(2,juo,2,iuo) = Saux(2,juo,2,iuo) + S(ind) * kphs |
276 | @@ -188,7 +187,10 @@ | |||
277 | 188 | kxij = kpoint(1,ik) * xij(1,ind) + | 187 | kxij = kpoint(1,ik) * xij(1,ind) + |
278 | 189 | . kpoint(2,ik) * xij(2,ind) + | 188 | . kpoint(2,ik) * xij(2,ind) + |
279 | 190 | . kpoint(3,ik) * xij(3,ind) | 189 | . kpoint(3,ik) * xij(3,ind) |
281 | 191 | kphs = cdexp(dcmplx(0.0_dp, 1.0_dp)*kxij) | 190 | ! Since we are doing element wise multiplications (and not dot-products) |
282 | 191 | ! we might as well setup the transpose S(k)^T == S(-k) because this will | ||
283 | 192 | ! mean that we can do a simpler multiplication further down | ||
284 | 193 | kphs = cdexp(dcmplx(0.0_dp, kxij)) | ||
285 | 192 | Spr(juo,iuo) = Spr(juo,iuo) + S(ind) * kphs | 194 | Spr(juo,iuo) = Spr(juo,iuo) + S(ind) * kphs |
286 | 193 | enddo | 195 | enddo |
287 | 194 | enddo | 196 | enddo |
288 | @@ -225,23 +227,19 @@ | |||
289 | 225 | ibandg = ibandg * 2 - mod(iband, 2) | 227 | ibandg = ibandg * 2 - mod(iband, 2) |
290 | 226 | diff = (ener - eo(ibandg,ik))**2 / (sigma ** 2) | 228 | diff = (ener - eo(ibandg,ik))**2 / (sigma ** 2) |
291 | 227 | if (diff .gt. 15.0d0) cycle | 229 | if (diff .gt. 15.0d0) cycle |
298 | 228 | gauss = exp(-diff) | 230 | gauss = exp(-diff) * wk(ik) |
299 | 229 | caux(:,:) = dcmplx(0.0_dp,0.0_dp) | 231 | caux => psi(:,:,iband) ! c_{up,j}, c_{down,j} |
294 | 230 | do j=1,nuotot | ||
295 | 231 | caux(1,j) = dcmplx(psi(1,1,j,iband),psi(2,1,j,iband)) ! c_{j,up) | ||
296 | 232 | caux(2,j) = dcmplx(psi(1,2,j,iband),psi(2,2,j,iband)) ! c_{j,down) | ||
297 | 233 | enddo | ||
300 | 234 | do jo = 1, Bnuo | 232 | do jo = 1, Bnuo |
301 | 235 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) | 233 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) |
302 | 236 | do io = 1, nuotot | 234 | do io = 1, nuotot |
303 | 237 | D11 = caux(1,io) * dconjg(caux(1,juo)) * Sloc(io,jo) | 235 | D11 = caux(1,io) * dconjg(caux(1,juo)) * Sloc(io,jo) |
304 | 238 | D22 = caux(2,io) * dconjg(caux(2,juo)) * Sloc(io,jo) | 236 | D22 = caux(2,io) * dconjg(caux(2,juo)) * Sloc(io,jo) |
305 | 239 | D12 = caux(1,io) * dconjg(caux(2,juo)) * Sloc(io,jo) | 237 | D12 = caux(1,io) * dconjg(caux(2,juo)) * Sloc(io,jo) |
307 | 240 | D21 = caux(2,io) * dconjg(caux(1,juo)) * Sloc(io,jo) | 238 | !D21 = caux(2,io) * dconjg(caux(1,juo)) * Sloc(io,jo) |
308 | 241 | 239 | ||
312 | 242 | D11 = gauss*wk(ik)*D11 | 240 | D11 = gauss*D11 |
313 | 243 | D22 = gauss*wk(ik)*D22 | 241 | D22 = gauss*D22 |
314 | 244 | D12 = gauss*wk(ik)*D12 | 242 | D12 = gauss*D12 |
315 | 245 | 243 | ||
316 | 246 | dpr(ihist,juo,1) = dpr(ihist,juo,1) + dreal(D11) | 244 | dpr(ihist,juo,1) = dpr(ihist,juo,1) + dreal(D11) |
317 | 247 | dpr(ihist,juo,2) = dpr(ihist,juo,2) + dreal(D22) | 245 | dpr(ihist,juo,2) = dpr(ihist,juo,2) + dreal(D22) |
318 | @@ -265,22 +263,18 @@ | |||
319 | 265 | do iband = 1, nuo*2 | 263 | do iband = 1, nuo*2 |
320 | 266 | diff = (ener - eo(iband,ik))**2 / (sigma ** 2) | 264 | diff = (ener - eo(iband,ik))**2 / (sigma ** 2) |
321 | 267 | if (diff .gt. 15.0d0) cycle | 265 | if (diff .gt. 15.0d0) cycle |
328 | 268 | gauss = exp(-diff) | 266 | gauss = exp(-diff) * wk(ik) |
329 | 269 | caux(:,:) = dcmplx(0.0_dp,0.0_dp) | 267 | caux => psi(:,:,iband) ! c_{up,j}, c_{down,j} |
324 | 270 | do j=1,nuotot | ||
325 | 271 | caux(1,j) = dcmplx(psi(1,1,j,iband),psi(2,1,j,iband)) ! c_{j,up) | ||
326 | 272 | caux(2,j) = dcmplx(psi(1,2,j,iband),psi(2,2,j,iband)) ! c_{j,down) | ||
327 | 273 | enddo | ||
330 | 274 | do io = 1, nuotot | 268 | do io = 1, nuotot |
331 | 275 | do jo = 1, nuotot | 269 | do jo = 1, nuotot |
332 | 276 | D11 = caux(1,io) * dconjg(caux(1,jo)) * Spr(io,jo) | 270 | D11 = caux(1,io) * dconjg(caux(1,jo)) * Spr(io,jo) |
333 | 277 | D22 = caux(2,io) * dconjg(caux(2,jo)) * Spr(io,jo) | 271 | D22 = caux(2,io) * dconjg(caux(2,jo)) * Spr(io,jo) |
334 | 278 | D12 = caux(1,io) * dconjg(caux(2,jo)) * Spr(io,jo) | 272 | D12 = caux(1,io) * dconjg(caux(2,jo)) * Spr(io,jo) |
336 | 279 | D21 = caux(2,io) * dconjg(caux(1,jo)) * Spr(io,jo) | 273 | !D21 = caux(2,io) * dconjg(caux(1,jo)) * Spr(io,jo) |
337 | 280 | 274 | ||
341 | 281 | D11 = gauss*wk(ik)*D11 | 275 | D11 = gauss*D11 |
342 | 282 | D22 = gauss*wk(ik)*D22 | 276 | D22 = gauss*D22 |
343 | 283 | D12 = gauss*wk(ik)*D12 | 277 | D12 = gauss*D12 |
344 | 284 | 278 | ||
345 | 285 | dpr(ihist,jo,1) = dpr(ihist,jo,1) + dreal(D11) | 279 | dpr(ihist,jo,1) = dpr(ihist,jo,1) + dreal(D11) |
346 | 286 | dpr(ihist,jo,2) = dpr(ihist,jo,2) + dreal(D22) | 280 | dpr(ihist,jo,2) = dpr(ihist,jo,2) + dreal(D22) |
347 | 287 | 281 | ||
348 | === modified file 'Src/pdosg.F' | |||
349 | --- Src/pdosg.F 2017-07-14 12:17:28 +0000 | |||
350 | +++ Src/pdosg.F 2018-04-18 08:41:10 +0000 | |||
351 | @@ -190,7 +190,7 @@ | |||
352 | 190 | if (diff .gt. 15.0d0) then | 190 | if (diff .gt. 15.0d0) then |
353 | 191 | cycle | 191 | cycle |
354 | 192 | else | 192 | else |
356 | 193 | gauss = ( exp(-diff) ) | 193 | gauss = exp(-diff) |
357 | 194 | if (Node.eq.BNode) then | 194 | if (Node.eq.BNode) then |
358 | 195 | C Only add once to dtot - not everytime loop over processors is executed | 195 | C Only add once to dtot - not everytime loop over processors is executed |
359 | 196 | dtot(ihist,ispin) = dtot(ihist,ispin) + gauss | 196 | dtot(ihist,ispin) = dtot(ihist,ispin) + gauss |
360 | @@ -224,10 +224,9 @@ | |||
361 | 224 | if (diff .gt. 15.0d0) then | 224 | if (diff .gt. 15.0d0) then |
362 | 225 | cycle | 225 | cycle |
363 | 226 | else | 226 | else |
365 | 227 | gauss = ( exp(-diff) ) | 227 | gauss = exp(-diff) |
366 | 228 | dtot(ihist,ispin) = dtot(ihist,ispin) + gauss | 228 | dtot(ihist,ispin) = dtot(ihist,ispin) + gauss |
367 | 229 | do iuo = 1, nuotot | 229 | do iuo = 1, nuotot |
368 | 230 | C Solo para los Juo que satisfagan el criterio del record... | ||
369 | 231 | do juo = 1, nuotot | 230 | do juo = 1, nuotot |
370 | 232 | pipj1 = psi(iuo,iband) * psi(juo,iband) | 231 | pipj1 = psi(iuo,iband) * psi(juo,iband) |
371 | 233 | dpr(ihist,juo,ispin) = dpr(ihist,juo,ispin) + | 232 | dpr(ihist,juo,ispin) = dpr(ihist,juo,ispin) + |
372 | 234 | 233 | ||
373 | === modified file 'Src/pdosk.F' | |||
374 | --- Src/pdosk.F 2016-06-04 20:06:11 +0000 | |||
375 | +++ Src/pdosk.F 2018-04-18 08:41:10 +0000 | |||
376 | @@ -87,7 +87,7 @@ | |||
377 | 87 | 87 | ||
378 | 88 | real(dp) | 88 | real(dp) |
379 | 89 | . kxij, Ckxij, Skxij, delta, ener, diff, pipj1, pipj2, | 89 | . kxij, Ckxij, Skxij, delta, ener, diff, pipj1, pipj2, |
381 | 90 | . pipjS1, pipjS2, gauss, norm, wksum | 90 | . pipjS1, gauss, norm, wksum |
382 | 91 | 91 | ||
383 | 92 | #ifdef MPI | 92 | #ifdef MPI |
384 | 93 | integer :: | 93 | integer :: |
385 | @@ -197,10 +197,11 @@ | |||
386 | 197 | . kpoint(3,IK) * xij(3,ind) | 197 | . kpoint(3,IK) * xij(3,ind) |
387 | 198 | ckxij = cos(kxij) | 198 | ckxij = cos(kxij) |
388 | 199 | skxij = sin(kxij) | 199 | skxij = sin(kxij) |
391 | 200 | C Calculates the hamiltonian and the overlap in k space | 200 | ! Since we are doing element wise multiplications (and not dot-products) |
392 | 201 | C H(k) = Sum(R) exp(i*k*R) * H(R) | 201 | ! we might as well setup the transpose S(k)^T == S(-k) because this will |
393 | 202 | ! mean that we can do a simpler multiplication further down | ||
394 | 202 | Saux(1,juo,iuo) = Saux(1,juo,iuo) + S(ind) * ckxij | 203 | Saux(1,juo,iuo) = Saux(1,juo,iuo) + S(ind) * ckxij |
396 | 203 | Saux(2,juo,iuo) = Saux(2,juo,iuo) - S(ind) * skxij | 204 | Saux(2,juo,iuo) = Saux(2,juo,iuo) + S(ind) * skxij |
397 | 204 | enddo | 205 | enddo |
398 | 205 | enddo | 206 | enddo |
399 | 206 | 207 | ||
400 | @@ -236,23 +237,22 @@ | |||
401 | 236 | if (diff .gt. 15.0D0) then | 237 | if (diff .gt. 15.0D0) then |
402 | 237 | cycle | 238 | cycle |
403 | 238 | else | 239 | else |
405 | 239 | gauss = ( EXP(-diff) ) | 240 | gauss = exp(-diff) * wk(ik) |
406 | 240 | if (Node.eq.BNode) then | 241 | if (Node.eq.BNode) then |
407 | 241 | C Only add once to dtot - not everytime loop over processors is executed | 242 | C Only add once to dtot - not everytime loop over processors is executed |
409 | 242 | dtot(ihist,ispin) = dtot(ihist,ispin) + gauss*WK(IK) | 243 | dtot(ihist,ispin) = dtot(ihist,ispin) + gauss |
410 | 243 | endif | 244 | endif |
411 | 244 | do jo = 1, Bnuo | 245 | do jo = 1, Bnuo |
412 | 245 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) | 246 | call LocalToGlobalOrb(jo,BNode,Nodes,juo) |
413 | 246 | do iuo = 1, nuotot | 247 | do iuo = 1, nuotot |
415 | 247 | C Solo para los Juo que satisfagan el criterio del record... | 248 | ! This is: psi(iuo) * psi(juo)^* |
416 | 248 | pipj1 = psi(1,iuo,iband) * psi(1,juo,iband) + | 249 | pipj1 = psi(1,iuo,iband) * psi(1,juo,iband) + |
417 | 249 | . psi(2,iuo,iband) * psi(2,juo,iband) | 250 | . psi(2,iuo,iband) * psi(2,juo,iband) |
419 | 250 | pipj2 = psi(1,iuo,iband) * psi(2,juo,iband) - | 251 | pipj2 = - psi(1,iuo,iband) * psi(2,juo,iband) + |
420 | 251 | . psi(2,iuo,iband) * psi(1,juo,iband) | 252 | . psi(2,iuo,iband) * psi(1,juo,iband) |
421 | 252 | pipjS1= pipj1*Sloc(1,iuo,JO)-pipj2*Sloc(2,iuo,JO) | 253 | pipjS1= pipj1*Sloc(1,iuo,JO)-pipj2*Sloc(2,iuo,JO) |
425 | 253 | pipjS2= pipj1*Sloc(2,iuo,JO)+pipj2*Sloc(1,iuo,JO) | 254 | dpr(ihist,juo,ispin)= dpr(ihist,juo,ispin) + |
426 | 254 | dpr(ihist,juo,ispin)= dpr(ihist,juo,ispin) + | 255 | . pipjS1*gauss |
424 | 255 | . pipjS1*gauss*WK(IK) | ||
427 | 256 | enddo | 256 | enddo |
428 | 257 | enddo | 257 | enddo |
429 | 258 | endif | 258 | endif |
430 | @@ -275,19 +275,17 @@ | |||
431 | 275 | if (diff .gt. 15.0d0) then | 275 | if (diff .gt. 15.0d0) then |
432 | 276 | cycle | 276 | cycle |
433 | 277 | else | 277 | else |
436 | 278 | gauss = ( EXP(-diff) ) | 278 | gauss = exp(-diff) * wk(ik) |
437 | 279 | dtot(ihist,ispin) = dtot(ihist,ispin) + gauss*WK(IK) | 279 | dtot(ihist,ispin) = dtot(ihist,ispin) + gauss |
438 | 280 | do iuo = 1, nuotot | 280 | do iuo = 1, nuotot |
439 | 281 | C Solo para los Juo que satisfagan el criterio del record... | ||
440 | 282 | do juo = 1, nuotot | 281 | do juo = 1, nuotot |
441 | 283 | pipj1 = psi(1,iuo,iband) * psi(1,juo,iband) + | 282 | pipj1 = psi(1,iuo,iband) * psi(1,juo,iband) + |
442 | 284 | . psi(2,iuo,iband) * psi(2,juo,iband) | 283 | . psi(2,iuo,iband) * psi(2,juo,iband) |
444 | 285 | pipj2 = psi(1,iuo,iband) * psi(2,juo,iband) - | 284 | pipj2 = - psi(1,iuo,iband) * psi(2,juo,iband) + |
445 | 286 | . psi(2,iuo,iband) * psi(1,juo,iband) | 285 | . psi(2,iuo,iband) * psi(1,juo,iband) |
446 | 287 | pipjS1= pipj1*Saux(1,iuo,juo)-pipj2*Saux(2,iuo,juo) | 286 | pipjS1= pipj1*Saux(1,iuo,juo)-pipj2*Saux(2,iuo,juo) |
447 | 288 | pipjS2= pipj1*Saux(2,iuo,juo)+pipj2*Saux(1,iuo,juo) | ||
448 | 289 | dpr(ihist,juo,ispin)= dpr(ihist,juo,ispin) + | 287 | dpr(ihist,juo,ispin)= dpr(ihist,juo,ispin) + |
450 | 290 | . pipjS1*gauss*WK(IK) | 288 | . pipjS1*gauss |
451 | 291 | enddo | 289 | enddo |
452 | 292 | enddo | 290 | enddo |
453 | 293 | endif | 291 | endif |
454 | 294 | 292 | ||
455 | === modified file 'Src/pdoskp.F' | |||
456 | --- Src/pdoskp.F 2016-04-05 09:54:38 +0000 | |||
457 | +++ Src/pdoskp.F 2018-04-18 08:41:10 +0000 | |||
458 | @@ -94,9 +94,9 @@ | |||
459 | 94 | 94 | ||
460 | 95 | real(dp) | 95 | real(dp) |
461 | 96 | . kxij, Ckxij, Skxij, delta, ener, diff, pipj1, pipj2, | 96 | . kxij, Ckxij, Skxij, delta, ener, diff, pipj1, pipj2, |
463 | 97 | . pipjS1, pipjS2, gauss, norm, wksum | 97 | . pipjS1, gauss, norm, wksum |
464 | 98 | 98 | ||
466 | 99 | real(dp), dimension(:), pointer :: Snew, Dloc | 99 | real(dp), dimension(:), pointer :: Snew |
467 | 100 | real(dp), dimension(:,:), pointer :: Hnew, xijloc | 100 | real(dp), dimension(:,:), pointer :: Hnew, xijloc |
468 | 101 | 101 | ||
469 | 102 | #ifdef MPI | 102 | #ifdef MPI |
470 | @@ -118,10 +118,6 @@ | |||
471 | 118 | call re_alloc( listhptrg, 1, nuotot, name='listhptrg', | 118 | call re_alloc( listhptrg, 1, nuotot, name='listhptrg', |
472 | 119 | & routine='pdoskp' ) | 119 | & routine='pdoskp' ) |
473 | 120 | 120 | ||
474 | 121 | C Find maximum value in numh and create local storage | ||
475 | 122 | nullify( Dloc ) | ||
476 | 123 | call re_alloc( Dloc, 1, nuotot, name='Dloc', routine='pdoskp' ) | ||
477 | 124 | |||
478 | 125 | C Globalise numh | 121 | C Globalise numh |
479 | 126 | do io = 1,nuotot | 122 | do io = 1,nuotot |
480 | 127 | call WhichNodeOrb(io,Nodes,BNode) | 123 | call WhichNodeOrb(io,Nodes,BNode) |
481 | @@ -290,16 +286,17 @@ | |||
482 | 290 | jo = listhg(ind) | 286 | jo = listhg(ind) |
483 | 291 | iuo = indxuo(io) | 287 | iuo = indxuo(io) |
484 | 292 | juo = indxuo(jo) | 288 | juo = indxuo(jo) |
486 | 293 | C Calculates the phases k*r_ij | 289 | C Calculate the phases k*r_ij |
487 | 294 | kxij = kpoint(1,ik) * xijloc(1,ind) + | 290 | kxij = kpoint(1,ik) * xijloc(1,ind) + |
488 | 295 | . kpoint(2,ik) * xijloc(2,ind) + | 291 | . kpoint(2,ik) * xijloc(2,ind) + |
489 | 296 | . kpoint(3,ik) * xijloc(3,ind) | 292 | . kpoint(3,ik) * xijloc(3,ind) |
490 | 297 | ckxij = cos(kxij) | 293 | ckxij = cos(kxij) |
491 | 298 | skxij = sin(kxij) | 294 | skxij = sin(kxij) |
494 | 299 | C Calculates the hamiltonian and the overlap in k space | 295 | ! Since we are doing element wise multiplications (and not dot-products) |
495 | 300 | C H(k) = Sum(R) exp(i*k*R) * H(R) | 296 | ! we might as well setup the transpose S(k)^T == S(-k) because this will |
496 | 297 | ! mean that we can do a simpler multiplication further down | ||
497 | 301 | Saux(1,juo,iuo) = Saux(1,juo,iuo) + Snew(ind) * ckxij | 298 | Saux(1,juo,iuo) = Saux(1,juo,iuo) + Snew(ind) * ckxij |
499 | 302 | Saux(2,juo,iuo) = Saux(2,juo,iuo) - Snew(ind) * skxij | 299 | Saux(2,juo,iuo) = Saux(2,juo,iuo) + Snew(ind) * skxij |
500 | 303 | enddo | 300 | enddo |
501 | 304 | enddo | 301 | enddo |
502 | 305 | 302 | ||
503 | @@ -311,19 +308,17 @@ | |||
504 | 311 | if (diff .gt. 15.0d0) then | 308 | if (diff .gt. 15.0d0) then |
505 | 312 | cycle | 309 | cycle |
506 | 313 | else | 310 | else |
512 | 314 | gauss = ( exp(-diff) ) | 311 | gauss = exp(-diff) * wk(ik) |
513 | 315 | dtot(ihist,is) = dtot(ihist,is) + gauss*wk(ik) | 312 | dtot(ihist,is) = dtot(ihist,is) + gauss |
514 | 316 | do iuo = 1, nuotot | 313 | do juo = 1, nuotot |
515 | 317 | C Solo para los Juo que satisfagan el criterio del record... | 314 | do iuo = 1, nuotot |
516 | 318 | do juo = 1, nuotot | 315 | ! This is: psi(iuo) * psi(juo)^* |
517 | 319 | pipj1 = psi(1,iuo,iband) * psi(1,juo,iband) + | 316 | pipj1 = psi(1,iuo,iband) * psi(1,juo,iband) + |
518 | 320 | . psi(2,iuo,iband) * psi(2,juo,iband) | 317 | . psi(2,iuo,iband) * psi(2,juo,iband) |
520 | 321 | pipj2 = psi(1,iuo,iband) * psi(2,juo,iband) - | 318 | pipj2 = - psi(1,iuo,iband) * psi(2,juo,iband) + |
521 | 322 | . psi(2,iuo,iband) * psi(1,juo,iband) | 319 | . psi(2,iuo,iband) * psi(1,juo,iband) |
526 | 323 | pipjS1= pipj1*Saux(1,iuo,juo)-pipj2*Saux(2,iuo,juo) | 320 | pipjS1 = pipj1*Saux(1,iuo,juo)-pipj2*Saux(2,iuo,juo) |
527 | 324 | pipjS2= pipj1*Saux(2,iuo,juo)+pipj2*Saux(1,iuo,juo) | 321 | dpr(ihist,juo,is) = dpr(ihist,juo,is) + pipjS1*gauss |
524 | 325 | dpr(ihist,juo,is) = dpr(ihist,juo,is) + | ||
525 | 326 | . pipjS1*gauss*wk(ik) | ||
528 | 327 | enddo | 322 | enddo |
529 | 328 | enddo | 323 | enddo |
530 | 329 | endif | 324 | endif |
531 | @@ -339,7 +334,6 @@ | |||
532 | 339 | call de_alloc( xijloc, name='xijloc' ) | 334 | call de_alloc( xijloc, name='xijloc' ) |
533 | 340 | call de_alloc( Hnew, name='Hnew' ) | 335 | call de_alloc( Hnew, name='Hnew' ) |
534 | 341 | call de_alloc( Snew, name='Snew' ) | 336 | call de_alloc( Snew, name='Snew' ) |
535 | 342 | call de_alloc( Dloc, name='Dloc' ) | ||
536 | 343 | call de_alloc( listhg, name='listhg' ) | 337 | call de_alloc( listhg, name='listhg' ) |
537 | 344 | call de_alloc( listhptrg, name='listhptrg' ) | 338 | call de_alloc( listhptrg, name='listhptrg' ) |
538 | 345 | call de_alloc( numhg, name='numhg' ) | 339 | call de_alloc( numhg, name='numhg' ) |
539 | 346 | 340 | ||
540 | === modified file 'version.info' | |||
541 | --- version.info 2018-04-17 13:06:00 +0000 | |||
542 | +++ version.info 2018-04-18 08:41:10 +0000 | |||
543 | @@ -1,1 +1,5 @@ | |||
544 | 1 | <<<<<<< TREE | ||
545 | 1 | siesta-4.1--893 | 2 | siesta-4.1--893 |
546 | 3 | ======= | ||
547 | 4 | siesta-4.1--892--phase-3 | ||
548 | 5 | >>>>>>> MERGE-SOURCE |
Good. I will merge.