mirror of
https://gitlab.com/scemama/qmcchem.git
synced 2024-11-07 06:33:38 +01:00
Merge branch 'qmckl' into 'qmckl'
First attempt at replacing SM-calls to QMCKL/SMW calls. See merge request scemama/qmcchem!3
This commit is contained in:
Anthony Scemama
commit
64b5ae3fb1
@ -7,7 +7,7 @@ CPU_TYPE="-mavx"
|
|||||||
## FORTRAN compiler
|
## FORTRAN compiler
|
||||||
FC="gfortran -ffree-line-length-none"
|
FC="gfortran -ffree-line-length-none"
|
||||||
FCFLAGS="-O2 -g ${CPU_TYPE}"
|
FCFLAGS="-O2 -g ${CPU_TYPE}"
|
||||||
LIB="-lblas -llapack -lpthread"
|
LIB="-lblas -llapack -lpthread -lqmckl"
|
||||||
|
|
||||||
## IRPF90
|
## IRPF90
|
||||||
IRPF90="${QMCCHEM_PATH}/bin/irpf90"
|
IRPF90="${QMCCHEM_PATH}/bin/irpf90"
|
||||||
|
|||||||
420
src/det.irp.f
420
src/det.irp.f
@ -20,7 +20,8 @@ END_PROVIDER
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
subroutine det_update(n,LDS,m,l,S,S_inv,d)
|
subroutine det_update(n,LDS,m,l,S,S_inv,d)
|
||||||
|
use qmckl
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer, intent(in) :: n,LDS ! Dimension of the vector
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
||||||
@ -30,169 +31,245 @@ subroutine det_update(n,LDS,m,l,S,S_inv,d)
|
|||||||
real,intent(inout) :: S(LDS,n) ! Slater matrix
|
real,intent(inout) :: S(LDS,n) ! Slater matrix
|
||||||
double precision,intent(inout) :: S_inv(LDS,n) ! Inverse Slater matrix
|
double precision,intent(inout) :: S_inv(LDS,n) ! Inverse Slater matrix
|
||||||
double precision,intent(inout) :: d ! Det(S)
|
double precision,intent(inout) :: d ! Det(S)
|
||||||
|
double precision :: zl, lambda, d_inv
|
||||||
|
|
||||||
if (d == 0.d0) then
|
if (d == 0.d0) then
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
select case (n)
|
|
||||||
case default
|
!! -- START QMCKL/SMW ADDITIONS -- !!
|
||||||
call det_update_general(n,LDS,m,l,S,S_inv,d)
|
!! !!
|
||||||
BEGIN_TEMPLATE
|
integer :: i, j
|
||||||
case ($n)
|
integer (qmckl_exit_code) :: rc
|
||||||
call det_update$n(n,LDS,m,l,S,S_inv,d)
|
integer (qmckl_context) :: context
|
||||||
SUBST [n]
|
integer(kind=8) :: ddim, nupdates, updates_index(1)
|
||||||
1;;
|
real(c_double) :: updates(n,1), breakdown
|
||||||
2;;
|
double precision :: S_inv_sq(n,n)
|
||||||
3;;
|
|
||||||
4;;
|
S_inv = S_inv / d
|
||||||
5;;
|
|
||||||
6;;
|
! open(unit = 2000, file = "Slater_old.dat")
|
||||||
7;;
|
! open(unit = 3000, file = "Slater_old_inv.dat")
|
||||||
8;;
|
! do i=1,n
|
||||||
9;;
|
! do j=1,n
|
||||||
10;;
|
! write(2000,"(E23.15, 1X)", advance="no") S(j,i) ! write transpose for Octave
|
||||||
11;;
|
! write(3000,"(E23.15, 1X)", advance="no") S_inv(i,j)
|
||||||
12;;
|
! end do
|
||||||
13;;
|
! write(2000,*)
|
||||||
14;;
|
! write(3000,*)
|
||||||
15;;
|
! end do
|
||||||
16;;
|
! flush(2000)
|
||||||
17;;
|
! flush(3000)
|
||||||
18;;
|
! close(2000)
|
||||||
19;;
|
! close(3000)
|
||||||
20;;
|
|
||||||
21;;
|
do i=1,n
|
||||||
22;;
|
updates(i,1) = m(i) - S(i,l) ! transform repl. upds. into additive upds.
|
||||||
23;;
|
S(i,l) = m(i) ! update S with repl. upds
|
||||||
24;;
|
end do
|
||||||
25;;
|
|
||||||
26;;
|
zl = 0
|
||||||
27;;
|
do i=1,n
|
||||||
28;;
|
zl = zl + S_inv(i,l) * updates(i,1)
|
||||||
29;;
|
end do
|
||||||
30;;
|
|
||||||
31;;
|
d_inv = 1.d0/d
|
||||||
32;;
|
d = d + zl
|
||||||
33;;
|
lambda = d * d_inv
|
||||||
34;;
|
if ( dabs(lambda) < 1.d-3 ) then
|
||||||
35;;
|
d = 0.d0
|
||||||
36;;
|
return
|
||||||
37;;
|
endif
|
||||||
38;;
|
|
||||||
39;;
|
context = qmckl_context_create()
|
||||||
40;;
|
ddim = n
|
||||||
41;;
|
nupdates = 1
|
||||||
42;;
|
updates_index(1) = l
|
||||||
43;;
|
breakdown = 1e-3
|
||||||
44;;
|
S_inv_sq = S_inv(1:n,1:n)
|
||||||
45;;
|
rc = qmckl_sherman_morrison_splitting(context, ddim, nupdates, updates, updates_index, breakdown, S_inv_sq)
|
||||||
46;;
|
S_inv = S_inv_sq(1:n,1:n)
|
||||||
47;;
|
rc = qmckl_context_destroy(context)
|
||||||
48;;
|
|
||||||
49;;
|
! open(unit = 4000, file = "Slater.dat")
|
||||||
50;;
|
! open(unit = 5000, file = "Slater_inv.dat")
|
||||||
51;;
|
! do i=1,n
|
||||||
52;;
|
! do j=1,n
|
||||||
53;;
|
! write(4000,"(E23.15, 1X)", advance="no") S(j,i) ! write transpose for Octave
|
||||||
54;;
|
! write(5000,"(E23.15, 1X)", advance="no") S_inv(i,j)
|
||||||
55;;
|
! end do
|
||||||
56;;
|
! write(4000,*)
|
||||||
57;;
|
! write(5000,*)
|
||||||
58;;
|
! end do
|
||||||
59;;
|
! flush(4000)
|
||||||
60;;
|
! flush(5000)
|
||||||
61;;
|
! close(4000)
|
||||||
62;;
|
! close(5000)
|
||||||
63;;
|
|
||||||
64;;
|
S_inv = S_inv * d
|
||||||
65;;
|
|
||||||
66;;
|
! select case (n)
|
||||||
67;;
|
! case default
|
||||||
68;;
|
! call det_update_general(n,LDS,m,l,S,S_inv,d)
|
||||||
69;;
|
! BEGIN_TEMPLATE
|
||||||
70;;
|
! case ($n)
|
||||||
71;;
|
! call det_update$n(n,LDS,m,l,S,S_inv,d)
|
||||||
72;;
|
! SUBST [n]
|
||||||
73;;
|
! 1;;
|
||||||
74;;
|
! 2;;
|
||||||
75;;
|
! 3;;
|
||||||
76;;
|
! 4;;
|
||||||
77;;
|
! 5;;
|
||||||
78;;
|
! 6;;
|
||||||
79;;
|
! 7;;
|
||||||
80;;
|
! 8;;
|
||||||
81;;
|
! 9;;
|
||||||
82;;
|
! 10;;
|
||||||
83;;
|
! 11;;
|
||||||
84;;
|
! 12;;
|
||||||
85;;
|
! 13;;
|
||||||
86;;
|
! 14;;
|
||||||
87;;
|
! 15;;
|
||||||
88;;
|
! 16;;
|
||||||
89;;
|
! 17;;
|
||||||
90;;
|
! 18;;
|
||||||
91;;
|
! 19;;
|
||||||
92;;
|
! 20;;
|
||||||
93;;
|
! 21;;
|
||||||
94;;
|
! 22;;
|
||||||
95;;
|
! 23;;
|
||||||
96;;
|
! 24;;
|
||||||
97;;
|
! 25;;
|
||||||
98;;
|
! 26;;
|
||||||
99;;
|
! 27;;
|
||||||
100;;
|
! 28;;
|
||||||
101;;
|
! 29;;
|
||||||
102;;
|
! 30;;
|
||||||
103;;
|
! 31;;
|
||||||
104;;
|
! 32;;
|
||||||
105;;
|
! 33;;
|
||||||
106;;
|
! 34;;
|
||||||
107;;
|
! 35;;
|
||||||
108;;
|
! 36;;
|
||||||
109;;
|
! 37;;
|
||||||
110;;
|
! 38;;
|
||||||
111;;
|
! 39;;
|
||||||
112;;
|
! 40;;
|
||||||
113;;
|
! 41;;
|
||||||
114;;
|
! 42;;
|
||||||
115;;
|
! 43;;
|
||||||
116;;
|
! 44;;
|
||||||
117;;
|
! 45;;
|
||||||
118;;
|
! 46;;
|
||||||
119;;
|
! 47;;
|
||||||
120;;
|
! 48;;
|
||||||
121;;
|
! 49;;
|
||||||
122;;
|
! 50;;
|
||||||
123;;
|
! 51;;
|
||||||
124;;
|
! 52;;
|
||||||
125;;
|
! 53;;
|
||||||
126;;
|
! 54;;
|
||||||
127;;
|
! 55;;
|
||||||
128;;
|
! 56;;
|
||||||
129;;
|
! 57;;
|
||||||
130;;
|
! 58;;
|
||||||
131;;
|
! 59;;
|
||||||
132;;
|
! 60;;
|
||||||
133;;
|
! 61;;
|
||||||
134;;
|
! 62;;
|
||||||
135;;
|
! 63;;
|
||||||
136;;
|
! 64;;
|
||||||
137;;
|
! 65;;
|
||||||
138;;
|
! 66;;
|
||||||
139;;
|
! 67;;
|
||||||
140;;
|
! 68;;
|
||||||
141;;
|
! 69;;
|
||||||
142;;
|
! 70;;
|
||||||
143;;
|
! 71;;
|
||||||
144;;
|
! 72;;
|
||||||
145;;
|
! 73;;
|
||||||
146;;
|
! 74;;
|
||||||
147;;
|
! 75;;
|
||||||
148;;
|
! 76;;
|
||||||
149;;
|
! 77;;
|
||||||
150;;
|
! 78;;
|
||||||
END_TEMPLATE
|
! 79;;
|
||||||
end select
|
! 80;;
|
||||||
|
! 81;;
|
||||||
|
! 82;;
|
||||||
|
! 83;;
|
||||||
|
! 84;;
|
||||||
|
! 85;;
|
||||||
|
! 86;;
|
||||||
|
! 87;;
|
||||||
|
! 88;;
|
||||||
|
! 89;;
|
||||||
|
! 90;;
|
||||||
|
! 91;;
|
||||||
|
! 92;;
|
||||||
|
! 93;;
|
||||||
|
! 94;;
|
||||||
|
! 95;;
|
||||||
|
! 96;;
|
||||||
|
! 97;;
|
||||||
|
! 98;;
|
||||||
|
! 99;;
|
||||||
|
! 100;;
|
||||||
|
! 101;;
|
||||||
|
! 102;;
|
||||||
|
! 103;;
|
||||||
|
! 104;;
|
||||||
|
! 105;;
|
||||||
|
! 106;;
|
||||||
|
! 107;;
|
||||||
|
! 108;;
|
||||||
|
! 109;;
|
||||||
|
! 110;;
|
||||||
|
! 111;;
|
||||||
|
! 112;;
|
||||||
|
! 113;;
|
||||||
|
! 114;;
|
||||||
|
! 115;;
|
||||||
|
! 116;;
|
||||||
|
! 117;;
|
||||||
|
! 118;;
|
||||||
|
! 119;;
|
||||||
|
! 120;;
|
||||||
|
! 121;;
|
||||||
|
! 122;;
|
||||||
|
! 123;;
|
||||||
|
! 124;;
|
||||||
|
! 125;;
|
||||||
|
! 126;;
|
||||||
|
! 127;;
|
||||||
|
! 128;;
|
||||||
|
! 129;;
|
||||||
|
! 130;;
|
||||||
|
! 131;;
|
||||||
|
! 132;;
|
||||||
|
! 133;;
|
||||||
|
! 134;;
|
||||||
|
! 135;;
|
||||||
|
! 136;;
|
||||||
|
! 137;;
|
||||||
|
! 138;;
|
||||||
|
! 139;;
|
||||||
|
! 140;;
|
||||||
|
! 141;;
|
||||||
|
! 142;;
|
||||||
|
! 143;;
|
||||||
|
! 144;;
|
||||||
|
! 145;;
|
||||||
|
! 146;;
|
||||||
|
! 147;;
|
||||||
|
! 148;;
|
||||||
|
! 149;;
|
||||||
|
! 150;;
|
||||||
|
! END_TEMPLATE
|
||||||
|
! end select
|
||||||
|
|
||||||
|
!! !!
|
||||||
|
!! -- END QMCKL/SMW ADDITIONS -- !!
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine det_update2(n,LDS,m,l,S,S_inv,d)
|
subroutine det_update2(n,LDS,m,l,S,S_inv,d)
|
||||||
@ -430,7 +507,7 @@ SUBST [ n ]
|
|||||||
|
|
||||||
END_TEMPLATE
|
END_TEMPLATE
|
||||||
|
|
||||||
BEGIN_TEMPLATE
|
BEGIN_TEMPLATE
|
||||||
! Version for mod(n,4) = 1
|
! Version for mod(n,4) = 1
|
||||||
subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
|
subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
|
||||||
implicit none
|
implicit none
|
||||||
@ -1186,7 +1263,7 @@ END_PROVIDER
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! det_alpha_value_curr : Value of the current alpha determinant
|
! det_alpha_value_curr : Value of the current alpha determinant
|
||||||
!
|
!
|
||||||
! det_alpha_value_curr : Slater matrix for the current alpha determinant.
|
! slater_matrix_alpha : Slater matrix for the current alpha determinant.
|
||||||
! 1st index runs over electrons and
|
! 1st index runs over electrons and
|
||||||
! 2nd index runs over MOs.
|
! 2nd index runs over MOs.
|
||||||
! Built with 1st determinant
|
! Built with 1st determinant
|
||||||
@ -1200,6 +1277,7 @@ END_PROVIDER
|
|||||||
double precision :: tmp_inv(elec_alpha_num_8)
|
double precision :: tmp_inv(elec_alpha_num_8)
|
||||||
real :: tmp_det(elec_alpha_num_8)
|
real :: tmp_det(elec_alpha_num_8)
|
||||||
integer, save :: ifirst
|
integer, save :: ifirst
|
||||||
|
logical :: file_exists
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: tmp_inv, tmp_det
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: tmp_inv, tmp_det
|
||||||
|
|
||||||
if (ifirst == 0) then
|
if (ifirst == 0) then
|
||||||
@ -1211,12 +1289,12 @@ END_PROVIDER
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
PROVIDE mo_value
|
PROVIDE mo_value
|
||||||
if (det_i /= det_alpha_order(1) ) then
|
if (det_i /= det_alpha_order(1) ) then ! alpha determinant order changes
|
||||||
|
|
||||||
n_to_do = 0
|
n_to_do = 0
|
||||||
do k=1,elec_alpha_num
|
do k=1,elec_alpha_num
|
||||||
imo = mo_list_alpha_curr(k)
|
imo = mo_list_alpha_curr(k)
|
||||||
if ( imo /= mo_list_alpha_prev(k) ) then
|
if ( imo /= mo_list_alpha_prev(k) ) then ! mo for electron k has changed
|
||||||
n_to_do += 1
|
n_to_do += 1
|
||||||
to_do(n_to_do) = k
|
to_do(n_to_do) = k
|
||||||
endif
|
endif
|
||||||
@ -1288,14 +1366,14 @@ END_PROVIDER
|
|||||||
ddet = 0.d0
|
ddet = 0.d0
|
||||||
|
|
||||||
if (n_to_do < shiftl(elec_alpha_num,1)) then
|
if (n_to_do < shiftl(elec_alpha_num,1)) then
|
||||||
|
|
||||||
do while ( n_to_do > 0 )
|
do while ( n_to_do > 0 )
|
||||||
ddet = det_alpha_value_curr
|
ddet = det_alpha_value_curr ! remember value of det_alpha_value_curr
|
||||||
n_to_do_old = n_to_do
|
n_to_do_old = n_to_do ! remember n_to_do value
|
||||||
n_to_do = 0
|
n_to_do = 0
|
||||||
do l=1,n_to_do_old
|
do l=1,n_to_do_old
|
||||||
k = to_do(l)
|
k = to_do(l) ! select electron to change
|
||||||
imo = mo_list_alpha_curr(k)
|
imo = mo_list_alpha_curr(k) ! select mo to change
|
||||||
|
! write(*,*) "k, imo, mo_value(1,imo) = ", k, imo, mo_value(1,imo)
|
||||||
call det_update(elec_alpha_num, elec_alpha_num_8, &
|
call det_update(elec_alpha_num, elec_alpha_num_8, &
|
||||||
mo_value(1,imo), &
|
mo_value(1,imo), &
|
||||||
k, &
|
k, &
|
||||||
@ -1344,12 +1422,13 @@ END_PROVIDER
|
|||||||
slater_matrix_alpha_inv_det(k,i) = mo_value(i,mo_list_alpha_curr(k))
|
slater_matrix_alpha_inv_det(k,i) = mo_value(i,mo_list_alpha_curr(k))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
! write(*,*) "FIRST TIME OR ALL FAILED; DO LAPACK"
|
||||||
call invert(slater_matrix_alpha_inv_det,elec_alpha_num_8,elec_alpha_num,ddet)
|
call invert(slater_matrix_alpha_inv_det,elec_alpha_num_8,elec_alpha_num,ddet)
|
||||||
|
|
||||||
endif
|
endif
|
||||||
ASSERT (ddet /= 0.d0)
|
ASSERT (ddet /= 0.d0)
|
||||||
|
|
||||||
det_alpha_value_curr = ddet
|
det_alpha_value_curr = ddet
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, det_beta_value_curr ]
|
BEGIN_PROVIDER [ double precision, det_beta_value_curr ]
|
||||||
@ -1467,6 +1546,7 @@ END_PROVIDER
|
|||||||
ddet = det_beta_value_curr
|
ddet = det_beta_value_curr
|
||||||
n_to_do_old = n_to_do
|
n_to_do_old = n_to_do
|
||||||
n_to_do = 0
|
n_to_do = 0
|
||||||
|
loopcount = 0
|
||||||
do l=1,n_to_do_old
|
do l=1,n_to_do_old
|
||||||
k = to_do(l)
|
k = to_do(l)
|
||||||
imo = mo_list_beta_curr(k)
|
imo = mo_list_beta_curr(k)
|
||||||
|
|||||||
@ -1 +1 @@
|
|||||||
Subproject commit de03986bda2be207377875ed5a0852cb721b86b9
|
Subproject commit 8535e3c0b5a4f4194ca0400b348774c3cc7c74d0
|
||||||
Loading…
Reference in New Issue
Block a user