| Revision | 2e2d9c89718b404e334968cd80edf57c6cb64dd9 (tree) |
|---|---|
| Zeit | 2018-11-09 14:09:55 |
| Autor |  Mitsuaki Kawamura <kawamitsuaki@gmai...> |
| Commiter | Mitsuaki Kawamura |
(WIP) LOBPCG
.gitignore (diff) src/lobpcg.F90 (diff)| @@ -2,3 +2,4 @@ | ||
| 2 | 2 | *.mod |
| 3 | 3 | *.x |
| 4 | 4 | make.inc |
| 5 | +*~ |
| @@ -0,0 +1,53 @@ | ||
| 1 | +module lobpcg | |
| 2 | + ! | |
| 3 | + implicit none | |
| 4 | + ! | |
| 5 | +contains | |
| 6 | + ! | |
| 7 | + subroutine diag_ovrp() | |
| 8 | + ! | |
| 9 | + integer,intent(in) :: nsub | |
| 10 | + complex(8),intent(inout) :: hsub(nsub,nsub), ovlp(nsub,nsub) | |
| 11 | + complex(8),intent(out) :: eval(nsub) | |
| 12 | + ! | |
| 13 | + liwork = 5 * nsub + 3 | |
| 14 | + lwork = nsub*nsub + 2 * nsub | |
| 15 | + lrwork = 3 * nsub*nsub + (4 + (int)log2(nsub) + 1) * nsub + 1 | |
| 16 | + ! | |
| 17 | + call zheev('V', 'U', nsub, ovlp, nsub, eval, work, lwork, rwork, info) | |
| 18 | + ! | |
| 19 | + nsub2 = 0 | |
| 20 | + do isub = 1, nsub | |
| 21 | + if(eval(isub) > 1.0d-14) then | |
| 22 | + nsub2 = nsub2 + 1 | |
| 23 | + ovlp(1:nsub,nsub2) = ovlp(1:nsub,isub) / sqrt(eval(isub)) | |
| 24 | + end if | |
| 25 | + end do | |
| 26 | + ovlp(1:nsub,nsub2+1:nsub) = 0.0d0 | |
| 27 | + ! | |
| 28 | + hsub(1:nsub2,1:nsub2) = matmul(conjg(transpose(ovlp(1:nsub,1:nsub2))), & | |
| 29 | + & matmul(hsub(1:nsub,1:nsub), ovlp(1:nsub,1:nsub2))) | |
| 30 | + ! | |
| 31 | + call zheev('V', 'U', nsub2, hsub, nsub, eval, work, lwork, rwork, info) | |
| 32 | + ! | |
| 33 | + hsub(1:nsub, 1:nsub2) = matmul(ovlp(1:nsub,1:nsub2), hsub(1:nsub2,1:nsub2)) | |
| 34 | + hsub(1:nsub, nsub2+1:nsub) = 0.0d0 | |
| 35 | + ! | |
| 36 | + end subroutine diag_ovrp | |
| 37 | + ! | |
| 38 | + subroutine lobpcg_main() | |
| 39 | + ! | |
| 40 | + nsub = 3 * nbnd | |
| 41 | + ! | |
| 42 | + call initialize(wxp(1:npw,1:nbnd,1)) | |
| 43 | + ! | |
| 44 | + hwxp(1:npw,1:nbnd,1) = 0.0d0 | |
| 45 | + ! | |
| 46 | + call h_psi(wxp(1:npw,1:nbnd,1), hwxp(1:npw,1:nbnd,1)) | |
| 47 | + ! | |
| 48 | + | |
| 49 | + | |
| 50 | + | |
| 51 | + end subroutine lobpcg_main | |
| 52 | + ! | |
| 53 | +end module lobpcg |
Fork