2021-06-07 23:41:37 +02:00
|
|
|
BEGIN_PROVIDER [ integer, det_i ]
|
|
|
|
&BEGIN_PROVIDER [ integer, det_i_prev ]
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
BEGIN_DOC
|
|
|
|
! Current running alpha determinant
|
|
|
|
END_DOC
|
|
|
|
det_i=det_alpha_order(1)
|
2021-06-07 23:41:37 +02:00
|
|
|
det_i_prev=det_alpha_order(1)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
END_PROVIDER
|
|
|
|
|
2021-06-07 23:41:37 +02:00
|
|
|
BEGIN_PROVIDER [ integer, det_j ]
|
|
|
|
&BEGIN_PROVIDER [ integer, det_j_prev ]
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
BEGIN_DOC
|
|
|
|
! Current running beta determinant
|
|
|
|
END_DOC
|
|
|
|
det_j=det_beta_order(1)
|
2021-06-07 23:41:37 +02:00
|
|
|
det_j_prev=det_beta_order(1)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
subroutine det_update(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m(LDS) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,n) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,n) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
if (d == 0.d0) then
|
|
|
|
return
|
|
|
|
endif
|
|
|
|
select case (n)
|
|
|
|
case default
|
|
|
|
call det_update_general(n,LDS,m,l,S,S_inv,d)
|
|
|
|
BEGIN_TEMPLATE
|
|
|
|
case ($n)
|
|
|
|
call det_update$n(n,LDS,m,l,S,S_inv,d)
|
|
|
|
SUBST [n]
|
|
|
|
1;;
|
|
|
|
2;;
|
|
|
|
3;;
|
|
|
|
4;;
|
|
|
|
5;;
|
|
|
|
6;;
|
|
|
|
7;;
|
|
|
|
8;;
|
|
|
|
9;;
|
|
|
|
10;;
|
|
|
|
11;;
|
|
|
|
12;;
|
|
|
|
13;;
|
|
|
|
14;;
|
|
|
|
15;;
|
|
|
|
16;;
|
|
|
|
17;;
|
|
|
|
18;;
|
|
|
|
19;;
|
|
|
|
20;;
|
|
|
|
21;;
|
|
|
|
22;;
|
|
|
|
23;;
|
|
|
|
24;;
|
|
|
|
25;;
|
|
|
|
26;;
|
|
|
|
27;;
|
|
|
|
28;;
|
|
|
|
29;;
|
|
|
|
30;;
|
|
|
|
31;;
|
|
|
|
32;;
|
|
|
|
33;;
|
|
|
|
34;;
|
|
|
|
35;;
|
|
|
|
36;;
|
|
|
|
37;;
|
|
|
|
38;;
|
|
|
|
39;;
|
|
|
|
40;;
|
|
|
|
41;;
|
|
|
|
42;;
|
|
|
|
43;;
|
|
|
|
44;;
|
|
|
|
45;;
|
|
|
|
46;;
|
|
|
|
47;;
|
|
|
|
48;;
|
|
|
|
49;;
|
|
|
|
50;;
|
2016-06-03 14:50:08 +02:00
|
|
|
51;;
|
|
|
|
52;;
|
|
|
|
53;;
|
|
|
|
54;;
|
|
|
|
55;;
|
|
|
|
56;;
|
|
|
|
57;;
|
|
|
|
58;;
|
|
|
|
59;;
|
|
|
|
60;;
|
|
|
|
61;;
|
|
|
|
62;;
|
|
|
|
63;;
|
|
|
|
64;;
|
|
|
|
65;;
|
|
|
|
66;;
|
|
|
|
67;;
|
|
|
|
68;;
|
|
|
|
69;;
|
|
|
|
70;;
|
|
|
|
71;;
|
|
|
|
72;;
|
|
|
|
73;;
|
|
|
|
74;;
|
|
|
|
75;;
|
|
|
|
76;;
|
|
|
|
77;;
|
|
|
|
78;;
|
|
|
|
79;;
|
|
|
|
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;;
|
2015-12-19 03:29:52 +01:00
|
|
|
END_TEMPLATE
|
|
|
|
end select
|
|
|
|
end
|
|
|
|
|
|
|
|
subroutine det_update2(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m(2) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,2) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,2) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
S(1,l) = m(1)
|
|
|
|
S(2,l) = m(2)
|
|
|
|
S_inv(1,1) = S(1,1)
|
|
|
|
S_inv(1,2) = S(2,1)
|
|
|
|
S_inv(2,1) = S(1,2)
|
|
|
|
S_inv(2,2) = S(2,2)
|
|
|
|
call invert2(S_inv,LDS,n,d)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
end
|
|
|
|
|
|
|
|
subroutine det_update1(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m(1) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,1) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,1) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
S(1,l) = m(1)
|
|
|
|
S_inv(1,1) = S(1,1)
|
|
|
|
call invert1(S_inv,LDS,n,d)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
end
|
|
|
|
|
|
|
|
subroutine det_update3(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m(3) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,3) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,3) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer :: i
|
|
|
|
do i=1,3
|
|
|
|
S(i,l) = m(i)
|
|
|
|
enddo
|
|
|
|
do i=1,3
|
|
|
|
S_inv(1,i) = S(i,1)
|
|
|
|
S_inv(2,i) = S(i,2)
|
|
|
|
S_inv(3,i) = S(i,3)
|
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
call invert3(S_inv,LDS,n,d)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
end
|
|
|
|
|
|
|
|
subroutine det_update4(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m(4) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,4) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,4) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
double precision :: u(4), z(4), w(4), lambda, d_inv
|
|
|
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: z, w, u
|
|
|
|
integer :: i,j
|
|
|
|
u(1) = m(1) - S(1,l)
|
|
|
|
u(2) = m(2) - S(2,l)
|
|
|
|
u(3) = m(3) - S(3,l)
|
|
|
|
u(4) = m(4) - S(4,l)
|
|
|
|
z(1) = S_inv(1,1)*u(1) + S_inv(2,1)*u(2) + S_inv(3,1)*u(3) + S_inv(4,1)*u(4)
|
|
|
|
z(2) = S_inv(1,2)*u(1) + S_inv(2,2)*u(2) + S_inv(3,2)*u(3) + S_inv(4,2)*u(4)
|
|
|
|
z(3) = S_inv(1,3)*u(1) + S_inv(2,3)*u(2) + S_inv(3,3)*u(3) + S_inv(4,3)*u(4)
|
|
|
|
z(4) = S_inv(1,4)*u(1) + S_inv(2,4)*u(2) + S_inv(3,4)*u(3) + S_inv(4,4)*u(4)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
d_inv = 1.d0/d
|
|
|
|
d = d+z(l)
|
|
|
|
lambda = d_inv*d
|
|
|
|
if (dabs(lambda) < 1.d-3) then
|
|
|
|
d = 0.d0
|
|
|
|
return
|
|
|
|
endif
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2016-06-03 14:50:08 +02:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,4
|
|
|
|
w(i) = S_inv(i,l)*d_inv
|
|
|
|
S(i,l) = m(i)
|
|
|
|
enddo
|
|
|
|
|
|
|
|
do i=1,4
|
|
|
|
!DIR$ VECTOR ALIGNED
|
|
|
|
do j=1,4
|
|
|
|
S_inv(j,i) = S_inv(j,i)*lambda -z(i)*w(j)
|
|
|
|
enddo
|
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
end
|
|
|
|
|
|
|
|
BEGIN_TEMPLATE
|
|
|
|
! Version for mod(n,4) = 0
|
|
|
|
subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m($n) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,$n) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,$n) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
double precision :: u($n), z($n), w($n), lambda, d_inv
|
|
|
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: z, w, u
|
|
|
|
!DIR$ ASSUME_ALIGNED S : $IRP_ALIGN
|
|
|
|
!DIR$ ASSUME_ALIGNED S_inv : $IRP_ALIGN
|
|
|
|
!DIR$ ASSUME (mod(LDS,$IRP_ALIGN/8) == 0)
|
|
|
|
!DIR$ ASSUME (LDS >= $n)
|
|
|
|
integer :: i,j
|
2016-06-06 18:21:32 +02:00
|
|
|
double precision :: zj, zj1, zj2, zj3
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n
|
|
|
|
u(i) = m(i) - S(i,l)
|
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2016-06-06 18:21:32 +02:00
|
|
|
zj = 0.d0
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2016-06-06 18:21:32 +02:00
|
|
|
do i=1,$n-1,4
|
|
|
|
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
|
2021-05-31 14:01:33 +02:00
|
|
|
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
|
|
|
|
|
|
|
d_inv = 1.d0/d
|
2016-06-06 18:21:32 +02:00
|
|
|
d = d+zj
|
2015-12-19 03:29:52 +01:00
|
|
|
lambda = d*d_inv
|
|
|
|
if (dabs(lambda) < 1.d-3) then
|
|
|
|
d = 0.d0
|
|
|
|
return
|
|
|
|
endif
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2016-06-03 14:50:08 +02:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2015-12-19 03:29:52 +01:00
|
|
|
do j=1,$n,4
|
2016-06-06 18:21:32 +02:00
|
|
|
zj = 0.d0
|
|
|
|
zj1 = 0.d0
|
|
|
|
zj2 = 0.d0
|
|
|
|
zj3 = 0.d0
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2016-06-03 23:45:01 +02:00
|
|
|
do i=1,$n
|
2016-06-06 18:21:32 +02:00
|
|
|
zj = zj + S_inv(i,j )*u(i)
|
|
|
|
zj1 = zj1 + S_inv(i,j+1)*u(i)
|
|
|
|
zj2 = zj2 + S_inv(i,j+2)*u(i)
|
|
|
|
zj3 = zj3 + S_inv(i,j+3)*u(i)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
z(j ) = zj
|
|
|
|
z(j+1) = zj1
|
|
|
|
z(j+2) = zj2
|
2016-06-06 18:21:32 +02:00
|
|
|
z(j+3) = zj3
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
|
|
|
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n
|
|
|
|
w(i) = S_inv(i,l)*d_inv
|
|
|
|
S(i,l) = m(i)
|
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n,4
|
2016-06-06 18:58:46 +02:00
|
|
|
zj = z(i )
|
|
|
|
zj1 = z(i+1)
|
|
|
|
zj2 = z(i+2)
|
|
|
|
zj3 = z(i+3)
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do j=1,$n
|
2016-06-06 18:58:46 +02:00
|
|
|
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*zj
|
|
|
|
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*zj1
|
|
|
|
S_inv(j,i+2) = S_inv(j,i+2)*lambda - w(j)*zj2
|
|
|
|
S_inv(j,i+3) = S_inv(j,i+3)*lambda - w(j)*zj3
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
SUBST [ n ]
|
|
|
|
8 ;;
|
|
|
|
12 ;;
|
|
|
|
16 ;;
|
|
|
|
20 ;;
|
|
|
|
24 ;;
|
|
|
|
28 ;;
|
|
|
|
32 ;;
|
|
|
|
36 ;;
|
|
|
|
40 ;;
|
|
|
|
44 ;;
|
|
|
|
48 ;;
|
2016-06-03 14:50:08 +02:00
|
|
|
52 ;;
|
|
|
|
56 ;;
|
|
|
|
60 ;;
|
|
|
|
64 ;;
|
|
|
|
68 ;;
|
|
|
|
72 ;;
|
|
|
|
76 ;;
|
|
|
|
80 ;;
|
|
|
|
84 ;;
|
|
|
|
88 ;;
|
|
|
|
92 ;;
|
|
|
|
96 ;;
|
|
|
|
100 ;;
|
|
|
|
104 ;;
|
|
|
|
108 ;;
|
|
|
|
112 ;;
|
|
|
|
116 ;;
|
|
|
|
120 ;;
|
|
|
|
124 ;;
|
|
|
|
128 ;;
|
|
|
|
132 ;;
|
|
|
|
136 ;;
|
|
|
|
140 ;;
|
|
|
|
144 ;;
|
|
|
|
148 ;;
|
2015-12-19 03:29:52 +01:00
|
|
|
|
|
|
|
END_TEMPLATE
|
|
|
|
|
|
|
|
BEGIN_TEMPLATE
|
|
|
|
! Version for mod(n,4) = 1
|
|
|
|
subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m($n) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,$n) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,$n) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
double precision :: u($n), z($n), w($n), lambda, d_inv
|
|
|
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: z, w, u
|
|
|
|
!DIR$ ASSUME_ALIGNED S : $IRP_ALIGN
|
|
|
|
!DIR$ ASSUME_ALIGNED S_inv : $IRP_ALIGN
|
|
|
|
!DIR$ ASSUME (mod(LDS,$IRP_ALIGN/8) == 0)
|
|
|
|
!DIR$ ASSUME (LDS >= $n)
|
|
|
|
integer :: i,j
|
2016-06-04 00:30:12 +02:00
|
|
|
double precision :: zj, zj1, zj2, zj3
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2016-06-04 00:30:12 +02:00
|
|
|
do i=1,$n
|
|
|
|
u(i) = m(i) - S(i,l)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-04 00:30:12 +02:00
|
|
|
|
|
|
|
zj = 0.d0
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2016-06-04 00:30:12 +02:00
|
|
|
do i=1,$n-1,4
|
|
|
|
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
|
2021-05-31 14:01:33 +02:00
|
|
|
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3)
|
2016-06-04 00:30:12 +02:00
|
|
|
enddo
|
|
|
|
zj = zj + S_inv($n,l)*u($n)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
d_inv = 1.d0/d
|
2016-06-04 00:30:12 +02:00
|
|
|
d = d+zj
|
2015-12-19 03:29:52 +01:00
|
|
|
lambda = d*d_inv
|
|
|
|
if (dabs(lambda) < 1.d-3) then
|
|
|
|
d = 0.d0
|
|
|
|
return
|
|
|
|
endif
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
|
|
|
do j=1,$n-1,4
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = 0.d0
|
|
|
|
zj1 = 0.d0
|
|
|
|
zj2 = 0.d0
|
|
|
|
zj3 = 0.d0
|
2016-06-03 14:50:08 +02:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n-1
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = zj + S_inv(i,j )*u(i)
|
|
|
|
zj1 = zj1 + S_inv(i,j+1)*u(i)
|
|
|
|
zj2 = zj2 + S_inv(i,j+2)*u(i)
|
|
|
|
zj3 = zj3 + S_inv(i,j+3)*u(i)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-04 00:30:12 +02:00
|
|
|
z(j ) = zj + S_inv($n,j )*u($n)
|
|
|
|
z(j+1) = zj1 + S_inv($n,j+1)*u($n)
|
|
|
|
z(j+2) = zj2 + S_inv($n,j+2)*u($n)
|
|
|
|
z(j+3) = zj3 + S_inv($n,j+3)*u($n)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
|
|
|
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = 0.d0
|
2016-06-03 14:50:08 +02:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
|
|
|
do i=1,$n-1
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = zj + S_inv(i,$n)*u(i)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-10 00:20:01 +02:00
|
|
|
z($n) = zj + S_inv($n,$n)*u($n)
|
2016-06-03 23:45:01 +02:00
|
|
|
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n
|
|
|
|
w(i) = S_inv(i,l)*d_inv
|
|
|
|
S(i,l) = m(i)
|
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n-1,4
|
2016-06-06 18:58:46 +02:00
|
|
|
zj = z(i )
|
|
|
|
zj1 = z(i+1)
|
|
|
|
zj2 = z(i+2)
|
|
|
|
zj3 = z(i+3)
|
2016-06-03 14:50:08 +02:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do j=1,$n-1
|
2016-06-06 18:58:46 +02:00
|
|
|
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*zj
|
|
|
|
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*zj1
|
|
|
|
S_inv(j,i+2) = S_inv(j,i+2)*lambda - w(j)*zj2
|
|
|
|
S_inv(j,i+3) = S_inv(j,i+3)*lambda - w(j)*zj3
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
S_inv($n,i ) = S_inv($n,i )*lambda - w($n)*zj
|
2016-06-06 18:58:46 +02:00
|
|
|
S_inv($n,i+1) = S_inv($n,i+1)*lambda - w($n)*zj1
|
|
|
|
S_inv($n,i+2) = S_inv($n,i+2)*lambda - w($n)*zj2
|
|
|
|
S_inv($n,i+3) = S_inv($n,i+3)*lambda - w($n)*zj3
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
|
|
|
|
2016-06-06 18:58:46 +02:00
|
|
|
zj = z($n)
|
2016-06-03 14:50:08 +02:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n
|
2016-06-06 18:58:46 +02:00
|
|
|
S_inv(i,$n) = S_inv(i,$n)*lambda -w(i)*zj
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
SUBST [ n ]
|
|
|
|
5 ;;
|
|
|
|
9 ;;
|
|
|
|
13 ;;
|
|
|
|
17 ;;
|
|
|
|
21 ;;
|
|
|
|
25 ;;
|
|
|
|
29 ;;
|
|
|
|
33 ;;
|
|
|
|
37 ;;
|
|
|
|
41 ;;
|
|
|
|
45 ;;
|
|
|
|
49 ;;
|
2016-06-03 14:50:08 +02:00
|
|
|
53 ;;
|
|
|
|
57 ;;
|
|
|
|
61 ;;
|
|
|
|
65 ;;
|
|
|
|
69 ;;
|
|
|
|
73 ;;
|
|
|
|
77 ;;
|
|
|
|
81 ;;
|
|
|
|
85 ;;
|
|
|
|
89 ;;
|
|
|
|
93 ;;
|
|
|
|
97 ;;
|
|
|
|
101 ;;
|
|
|
|
105 ;;
|
|
|
|
109 ;;
|
|
|
|
113 ;;
|
|
|
|
117 ;;
|
|
|
|
121 ;;
|
|
|
|
125 ;;
|
|
|
|
129 ;;
|
|
|
|
133 ;;
|
|
|
|
137 ;;
|
|
|
|
141 ;;
|
|
|
|
145 ;;
|
|
|
|
149 ;;
|
2015-12-19 03:29:52 +01:00
|
|
|
|
|
|
|
END_TEMPLATE
|
|
|
|
|
|
|
|
|
|
|
|
BEGIN_TEMPLATE
|
|
|
|
! Version for mod(n,4) = 2
|
|
|
|
subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m($n) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,$n) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,$n) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
double precision :: u($n), z($n), w($n), lambda, d_inv
|
|
|
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: z, w, u
|
|
|
|
!DIR$ ASSUME_ALIGNED S : $IRP_ALIGN
|
|
|
|
!DIR$ ASSUME_ALIGNED S_inv : $IRP_ALIGN
|
|
|
|
!DIR$ ASSUME (mod(LDS,$IRP_ALIGN/8) == 0)
|
|
|
|
!DIR$ ASSUME (LDS >= $n)
|
|
|
|
integer :: i,j
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2016-06-04 00:30:12 +02:00
|
|
|
double precision :: zj, zj1, zj2, zj3
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n
|
|
|
|
u(i) = m(i) - S(i,l)
|
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = 0.d0
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2016-06-03 23:45:01 +02:00
|
|
|
do i=1,$n-2,4
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
|
2021-05-31 14:01:33 +02:00
|
|
|
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-03 23:45:01 +02:00
|
|
|
i=$n-1
|
2021-05-31 14:01:33 +02:00
|
|
|
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1)
|
2015-12-19 03:29:52 +01:00
|
|
|
|
|
|
|
d_inv = 1.d0/d
|
2016-06-04 00:30:12 +02:00
|
|
|
d = d+zj
|
2015-12-19 03:29:52 +01:00
|
|
|
lambda = d*d_inv
|
|
|
|
if (dabs(lambda) < 1.d-3) then
|
|
|
|
d = 0.d0
|
|
|
|
return
|
|
|
|
endif
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2016-06-03 14:50:08 +02:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2015-12-19 03:29:52 +01:00
|
|
|
do j=1,$n-2,4
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = 0.d0
|
|
|
|
zj1 = 0.d0
|
|
|
|
zj2 = 0.d0
|
|
|
|
zj3 = 0.d0
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-03 23:45:01 +02:00
|
|
|
do i=1,$n-2
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = zj + S_inv(i,j )*u(i)
|
|
|
|
zj1 = zj1 + S_inv(i,j+1)*u(i)
|
|
|
|
zj2 = zj2 + S_inv(i,j+2)*u(i)
|
|
|
|
zj3 = zj3 + S_inv(i,j+3)*u(i)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-04 00:30:12 +02:00
|
|
|
z(j ) = zj + S_inv($n-1,j )*u($n-1)
|
2016-06-03 23:45:01 +02:00
|
|
|
z(j ) = z(j ) + S_inv($n,j )*u($n)
|
2016-06-04 00:30:12 +02:00
|
|
|
z(j+1) = zj1 + S_inv($n-1,j+1)*u($n-1)
|
2016-06-03 23:45:01 +02:00
|
|
|
z(j+1) = z(j+1) + S_inv($n,j+1)*u($n)
|
2016-06-04 00:30:12 +02:00
|
|
|
z(j+2) = zj2 + S_inv($n-1,j+2)*u($n-1)
|
2016-06-03 23:45:01 +02:00
|
|
|
z(j+2) = z(j+2) + S_inv($n,j+2)*u($n)
|
2016-06-04 00:30:12 +02:00
|
|
|
z(j+3) = zj3 + S_inv($n-1,j+3)*u($n-1)
|
2016-06-03 23:45:01 +02:00
|
|
|
z(j+3) = z(j+3) + S_inv($n,j+3)*u($n)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
|
|
|
|
|
|
|
j=$n-1
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = 0.d0
|
|
|
|
zj1 = 0.d0
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2016-06-03 23:45:01 +02:00
|
|
|
do i=1,$n-2
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = zj + S_inv(i,j )*u(i)
|
|
|
|
zj1 = zj1 + S_inv(i,j+1)*u(i)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-04 00:30:12 +02:00
|
|
|
z(j ) = zj + S_inv($n-1,j )*u($n-1)
|
2016-06-03 23:45:01 +02:00
|
|
|
z(j ) = z(j ) + S_inv($n,j )*u($n)
|
2016-06-04 00:30:12 +02:00
|
|
|
z(j+1) = zj1 + S_inv($n-1,j+1)*u($n-1)
|
2016-06-03 23:45:01 +02:00
|
|
|
z(j+1) = z(j+1) + S_inv($n,j+1)*u($n)
|
2015-12-19 03:29:52 +01:00
|
|
|
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n
|
|
|
|
w(i) = S_inv(i,l)*d_inv
|
|
|
|
S(i,l) = m(i)
|
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n-2,4
|
2016-06-06 18:58:46 +02:00
|
|
|
zj = z(i)
|
|
|
|
zj1 = z(i+1)
|
|
|
|
zj2 = z(i+2)
|
|
|
|
zj3 = z(i+3)
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-03 23:45:01 +02:00
|
|
|
do j=1,$n-2
|
2016-06-06 18:58:46 +02:00
|
|
|
S_inv(j,i ) = S_inv(j,i )*lambda -zj *w(j)
|
|
|
|
S_inv(j,i+1) = S_inv(j,i+1)*lambda -zj1*w(j)
|
|
|
|
S_inv(j,i+2) = S_inv(j,i+2)*lambda -zj2*w(j)
|
|
|
|
S_inv(j,i+3) = S_inv(j,i+3)*lambda -zj3*w(j)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-06 18:58:46 +02:00
|
|
|
S_inv($n-1,i ) = S_inv($n-1,i )*lambda -zj *w($n-1)
|
|
|
|
S_inv($n ,i ) = S_inv($n ,i )*lambda -zj *w($n )
|
|
|
|
S_inv($n-1,i+1) = S_inv($n-1,i+1)*lambda -zj1*w($n-1)
|
|
|
|
S_inv($n ,i+1) = S_inv($n ,i+1)*lambda -zj1*w($n )
|
|
|
|
S_inv($n-1,i+2) = S_inv($n-1,i+2)*lambda -zj2*w($n-1)
|
|
|
|
S_inv($n ,i+2) = S_inv($n ,i+2)*lambda -zj2*w($n )
|
|
|
|
S_inv($n-1,i+3) = S_inv($n-1,i+3)*lambda -zj3*w($n-1)
|
|
|
|
S_inv($n ,i+3) = S_inv($n ,i+3)*lambda -zj3*w($n )
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
|
|
|
|
|
|
|
i=$n-1
|
2016-06-06 18:58:46 +02:00
|
|
|
zj = z(i)
|
|
|
|
zj1= z(i+1)
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-03 23:45:01 +02:00
|
|
|
do j=1,$n-2
|
2016-06-06 18:58:46 +02:00
|
|
|
S_inv(j,i ) = S_inv(j,i )*lambda -zj*w(j)
|
|
|
|
S_inv(j,i+1) = S_inv(j,i+1)*lambda -zj1*w(j)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-06 18:58:46 +02:00
|
|
|
S_inv($n-1,i ) = S_inv($n-1,i )*lambda -zj*w($n-1)
|
|
|
|
S_inv($n-1,i+1) = S_inv($n-1,i+1)*lambda -zj1*w($n-1)
|
|
|
|
S_inv($n ,i ) = S_inv($n ,i )*lambda -zj*w($n )
|
|
|
|
S_inv($n ,i+1) = S_inv($n ,i+1)*lambda -zj1*w($n )
|
2015-12-19 03:29:52 +01:00
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
SUBST [ n ]
|
|
|
|
6 ;;
|
|
|
|
10 ;;
|
|
|
|
14 ;;
|
|
|
|
18 ;;
|
|
|
|
22 ;;
|
|
|
|
26 ;;
|
|
|
|
30 ;;
|
|
|
|
34 ;;
|
|
|
|
38 ;;
|
|
|
|
42 ;;
|
|
|
|
46 ;;
|
|
|
|
50 ;;
|
2016-06-03 14:50:08 +02:00
|
|
|
54 ;;
|
|
|
|
58 ;;
|
|
|
|
62 ;;
|
|
|
|
66 ;;
|
|
|
|
70 ;;
|
|
|
|
74 ;;
|
|
|
|
78 ;;
|
|
|
|
82 ;;
|
|
|
|
86 ;;
|
|
|
|
90 ;;
|
|
|
|
94 ;;
|
|
|
|
98 ;;
|
|
|
|
102 ;;
|
|
|
|
106 ;;
|
|
|
|
110 ;;
|
|
|
|
114 ;;
|
|
|
|
118 ;;
|
|
|
|
122 ;;
|
|
|
|
126 ;;
|
|
|
|
130 ;;
|
|
|
|
134 ;;
|
|
|
|
138 ;;
|
|
|
|
142 ;;
|
|
|
|
146 ;;
|
|
|
|
150 ;;
|
2015-12-19 03:29:52 +01:00
|
|
|
|
|
|
|
END_TEMPLATE
|
|
|
|
|
|
|
|
BEGIN_TEMPLATE
|
|
|
|
! Version for mod(n,4) = 3
|
|
|
|
subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
|
|
|
|
implicit none
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
integer, intent(in) :: n,LDS ! Dimension of the vector
|
|
|
|
real, intent(in) :: m($n) ! New vector
|
|
|
|
integer, intent(in) :: l ! New position in S
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
real,intent(inout) :: S(LDS,$n) ! Slater matrix
|
|
|
|
double precision,intent(inout) :: S_inv(LDS,$n) ! Inverse Slater matrix
|
|
|
|
double precision,intent(inout) :: d ! Det(S)
|
2021-05-31 14:01:33 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
double precision :: u($n), z($n), w($n), lambda, d_inv
|
|
|
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: z, w, u
|
|
|
|
!DIR$ ASSUME_ALIGNED S : $IRP_ALIGN
|
|
|
|
!DIR$ ASSUME_ALIGNED S_inv : $IRP_ALIGN
|
|
|
|
!DIR$ ASSUME (mod(LDS,$IRP_ALIGN/8) == 0)
|
|
|
|
!DIR$ ASSUME (LDS >= $n)
|
|
|
|
integer :: i,j
|
2016-06-04 00:30:12 +02:00
|
|
|
|
|
|
|
double precision :: zj, zj1, zj2, zj3
|
2016-06-22 23:18:21 +02:00
|
|
|
|
2015-12-19 03:29:52 +01:00
|
|
|
do i=1,$n
|
|
|
|
u(i) = m(i) - S(i,l)
|
|
|
|
enddo
|
2021-05-31 14:01:33 +02:00
|
|
|
|
|
|
|
zj = 0.d0
|
2015-12-19 03:29:52 +01:00
|
|
|
!DIR$ VECTOR ALIGNED
|
2016-06-10 00:20:01 +02:00
|
|
|
!DIR$ NOPREFETCH
|
2016-06-03 23:45:01 +02:00
|
|
|
do i=1,$n-3,4
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
|
2021-05-31 14:01:33 +02:00
|
|
|
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3)
|
2015-12-19 03:29:52 +01:00
|
|
|
enddo
|
2016-06-03 23:45:01 +02:00
|
|
|
i=$n-2
|
2016-06-04 00:30:12 +02:00
|
|
|
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) + S_inv(i+2,l)*u(i+2)
|
2015-12-19 03:29:52 +01:00
|
|
|
|
|
|
|
|
|
|
|
d_inv = 1.d0/d
|
2016-06-04 00:30:12 +02:00
|
|
|
d = d+zj
|
2015-12-19 03:29:52 +01:00
|
|
|
lambda = d*d_inv
|
|
|
|