10
1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-12-21 20:03:31 +01:00

Specific det_updates up to 150x150

This commit is contained in:
Anthony Scemama 2016-06-03 14:50:08 +02:00
parent 6208018b4a
commit 5c872ed2aa

View File

@ -87,6 +87,106 @@ subroutine det_update(n,LDS,m,l,S,S_inv,d)
48;;
49;;
50;;
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;;
END_TEMPLATE
end select
end
@ -186,6 +286,7 @@ subroutine det_update4(n,LDS,m,l,S,S_inv,d)
return
endif
!DIR$ VECTOR ALIGNED
do i=1,4
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
@ -221,6 +322,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (LDS >= $n)
integer :: i,j
!DIR$ VECTOR ALIGNED
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
@ -239,6 +341,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
return
endif
!DIR$ VECTOR ALIGNED
do j=1,$n,4
z(j ) = S_inv($n,j )*u($n)
z(j+1) = S_inv($n,j+1)*u($n)
@ -253,6 +356,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
enddo
enddo
!DIR$ VECTOR ALIGNED
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
@ -282,6 +386,31 @@ SUBST [ n ]
40 ;;
44 ;;
48 ;;
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 ;;
END_TEMPLATE
@ -306,6 +435,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (LDS >= $n)
integer :: i,j
!DIR$ VECTOR ALIGNED
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
@ -330,6 +460,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
z(j+1) = S_inv($n,j+1)*u($n)
z(j+2) = S_inv($n,j+2)*u($n)
z(j+3) = S_inv($n,j+3)*u($n)
!DIR$ VECTOR ALIGNED
do i=1,$n-1
z(j ) = z(j ) + S_inv(i,j )*u(i)
z(j+1) = z(j+1) + S_inv(i,j+1)*u(i)
@ -339,15 +470,18 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
enddo
z($n) = S_inv($n,$n)*u($n)
!DIR$ VECTOR ALIGNED
do i=1,$n-1
z($n) = z($n) + S_inv(i,$n)*u(i)
enddo
!DIR$ VECTOR ALIGNED
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
enddo
do i=1,$n-1,4
!DIR$ VECTOR ALIGNED
do j=1,$n-1
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*z(i )
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*z(i+1)
@ -356,6 +490,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
enddo
enddo
!DIR$ VECTOR ALIGNED
do i=1,$n-1,4
S_inv($n,i ) = S_inv($n,i )*lambda - w($n)*z(i )
S_inv($n,i+1) = S_inv($n,i+1)*lambda - w($n)*z(i+1)
@ -363,6 +498,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
S_inv($n,i+3) = S_inv($n,i+3)*lambda - w($n)*z(i+3)
enddo
!DIR$ VECTOR ALIGNED
do i=1,$n
S_inv(i,$n) = S_inv(i,$n)*lambda -w(i)*z($n)
enddo
@ -383,6 +519,31 @@ SUBST [ n ]
41 ;;
45 ;;
49 ;;
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 ;;
END_TEMPLATE
@ -408,6 +569,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (LDS >= $n)
integer :: i,j
!DIR$ VECTOR ALIGNED
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
@ -426,6 +588,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
return
endif
!DIR$ VECTOR ALIGNED
do j=1,$n-2,4
z(j ) = S_inv($n,j )*u($n)
z(j+1) = S_inv($n,j+1)*u($n)
@ -449,6 +612,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
z(j+1) = z(j+1) + S_inv(i,j+1)*u(i)
enddo
!DIR$ VECTOR ALIGNED
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
@ -486,6 +650,31 @@ SUBST [ n ]
42 ;;
46 ;;
50 ;;
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 ;;
END_TEMPLATE
@ -510,6 +699,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (LDS >= $n)
integer :: i,j
!DIR$ VECTOR ALIGNED
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
@ -535,6 +725,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
z(j+1) = S_inv($n,j+1)*u($n)
z(j+2) = S_inv($n,j+2)*u($n)
z(j+3) = S_inv($n,j+3)*u($n)
!DIR$ VECTOR ALIGNED
do i=1,$n-1
z(j ) = z(j ) + S_inv(i,j )*u(i)
z(j+1) = z(j+1) + S_inv(i,j+1)*u(i)
@ -547,18 +738,21 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
z(j ) = S_inv($n,j )*u($n)
z(j+1) = S_inv($n,j+1)*u($n)
z(j+2) = S_inv($n,j+2)*u($n)
!DIR$ VECTOR ALIGNED
do i=1,$n-1
z(j ) = z(j ) + S_inv(i,j )*u(i)
z(j+1) = z(j+1) + S_inv(i,j+1)*u(i)
z(j+2) = z(j+2) + S_inv(i,j+2)*u(i)
enddo
!DIR$ VECTOR ALIGNED
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
enddo
do i=1,$n-3,4
!DIR$ VECTOR ALIGNED
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*z(i )
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*z(i+1)
@ -568,6 +762,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
enddo
i=$n-2
!DIR$ VECTOR ALIGNED
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*z(i )
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*z(i+1)
@ -588,6 +783,31 @@ SUBST [ n ]
39 ;;
43 ;;
47 ;;
51 ;;
55 ;;
59 ;;
63 ;;
67 ;;
71 ;;
75 ;;
79 ;;
83 ;;
87 ;;
91 ;;
95 ;;
99 ;;
103 ;;
107 ;;
111 ;;
115 ;;
119 ;;
123 ;;
127 ;;
131 ;;
135 ;;
139 ;;
143 ;;
147 ;;
END_TEMPLATE
@ -612,8 +832,11 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (LDS >= n)
!DIR$ ASSUME (LDS <= 3840)
!DIR$ ASSUME (MOD(LDS,$IRP_ALIGN/8) == 0)
!DIR$ ASSUME (n>150)
integer :: i,j,n4
!DIR$ VECTOR ALIGNED
do i=1,n
u(i) = m(i) - S(i,l)
enddo
@ -633,26 +856,19 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
return
endif
n4 = iand(n,not(4))
do j=1,n4,8
n4 = iand(n,not(3))
!DIR$ VECTOR ALIGNED
do j=1,n4,4
z(j ) = 0.d0
z(j+1) = 0.d0
z(j+2) = 0.d0
z(j+3) = 0.d0
z(j+4) = 0.d0
z(j+5) = 0.d0
z(j+6) = 0.d0
z(j+7) = 0.d0
!DIR$ VECTOR ALIGNED
do i=1,n
z(j ) = z(j ) + S_inv(i,j )*u(i)
z(j+1) = z(j+1) + S_inv(i,j+1)*u(i)
z(j+2) = z(j+2) + S_inv(i,j+2)*u(i)
z(j+3) = z(j+3) + S_inv(i,j+3)*u(i)
z(j+4) = z(j+4) + S_inv(i,j+4)*u(i)
z(j+5) = z(j+5) + S_inv(i,j+5)*u(i)
z(j+6) = z(j+6) + S_inv(i,j+6)*u(i)
z(j+7) = z(j+7) + S_inv(i,j+7)*u(i)
enddo
enddo
@ -664,16 +880,29 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
enddo
enddo
!DIR$ VECTOR ALIGNED
do i=1,n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
enddo
do i=1,n
!DIR$ VECTOR ALIGNED
do j=1,n
S_inv(j,i) = S_inv(j,i)*lambda -z(i)*w(j)
enddo
do i=1,n4,4
!DIR$ VECTOR ALIGNED
!DIR$ VECTOR ALWAYS
do j=1,n
S_inv(j,i ) = S_inv(j,i )*lambda -z(i )*w(j)
S_inv(j,i+1) = S_inv(j,i+1)*lambda -z(i+1)*w(j)
S_inv(j,i+2) = S_inv(j,i+2)*lambda -z(i+2)*w(j)
S_inv(j,i+3) = S_inv(j,i+3)*lambda -z(i+3)*w(j)
enddo
enddo
do i=n4+1,n
!DIR$ VECTOR ALIGNED
!DIR$ VECTOR ALWAYS
do j=1,n
S_inv(j,i) = S_inv(j,i)*lambda -z(i)*w(j)
enddo
enddo
end
@ -1008,6 +1237,7 @@ END_PROVIDER
det_alpha_value(det_i) = det_alpha_value_curr
do i=1,elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
det_alpha_grad_lapl(k,i,det_i) = det_alpha_grad_lapl_curr(k,i)
enddo
@ -1214,6 +1444,7 @@ END_PROVIDER
do i=1,det_alpha_num
do j=1,elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_alpha_grad_lapl(k,j,i)*CDb(i)
enddo
@ -1223,6 +1454,7 @@ END_PROVIDER
do i=1,det_beta_num
do j=elec_alpha_num+1,elec_num
!DIR$ VECTOR ALIGNED
do k=1,4
psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_beta_grad_lapl(k,j,i)*DaC(i)
enddo
@ -1230,18 +1462,21 @@ END_PROVIDER
enddo
enddo
!DIR$ VECTOR ALIGNED
do j=1,elec_num
pseudo_non_local(j) = pseudo_non_local(j) * psidet_inv
enddo
else
!DIR$ VECTOR ALIGNED
do j=1,elec_num
psidet_grad_lapl(1:4,j) = 0.d0
enddo
do i=1,det_alpha_num
do j=1,elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_alpha_grad_lapl(k,j,i)*CDb(i)
enddo
@ -1250,6 +1485,7 @@ END_PROVIDER
do i=1,det_beta_num
do j=elec_alpha_num+1,elec_num
!DIR$ VECTOR ALIGNED
do k=1,4
psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_beta_grad_lapl(k,j,i)*DaC(i)
enddo
@ -1352,6 +1588,7 @@ BEGIN_PROVIDER [ double precision, det_alpha_grad_lapl_curr, (4,elec_alpha_num)
imo = mo_list_alpha_curr(j )
imo2 = mo_list_alpha_curr(j+1)
do i=1,elec_alpha_num,2
!DIR$ VECTOR ALIGNED
do k=1,4
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl_alpha(k,i ,imo )*slater_matrix_alpha_inv_det(i ,j ) &
+ mo_grad_lapl_alpha(k,i ,imo2)*slater_matrix_alpha_inv_det(i ,j+1)
@ -1367,6 +1604,7 @@ BEGIN_PROVIDER [ double precision, det_alpha_grad_lapl_curr, (4,elec_alpha_num)
imo = mo_list_alpha_curr(j )
imo2 = mo_list_alpha_curr(j+1)
do i=1,elec_alpha_num-1,2
!DIR$ VECTOR ALIGNED
do k=1,4
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl_alpha(k,i ,imo )*slater_matrix_alpha_inv_det(i ,j ) &
+ mo_grad_lapl_alpha(k,i ,imo2)*slater_matrix_alpha_inv_det(i ,j+1)
@ -1375,6 +1613,7 @@ BEGIN_PROVIDER [ double precision, det_alpha_grad_lapl_curr, (4,elec_alpha_num)
enddo
enddo
i=elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
det_alpha_grad_lapl_curr(k,i) = det_alpha_grad_lapl_curr(k,i) + mo_grad_lapl_alpha(k,i,imo )*slater_matrix_alpha_inv_det(i,j ) &
+ mo_grad_lapl_alpha(k,i,imo2)*slater_matrix_alpha_inv_det(i,j+1)
@ -1384,6 +1623,7 @@ BEGIN_PROVIDER [ double precision, det_alpha_grad_lapl_curr, (4,elec_alpha_num)
j=elec_alpha_num
imo = mo_list_alpha_curr(j)
do i=1,elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl_alpha(k,i ,imo)*slater_matrix_alpha_inv_det(i ,j)
enddo
@ -1436,6 +1676,7 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1
!DIR$ LOOP COUNT (16)
do i=elec_alpha_num+1,elec_num,2
l = i-elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
mo_grad_lapl_beta(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
@ -1455,6 +1696,7 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1
!DIR$ LOOP COUNT (16)
do i=elec_alpha_num+1,elec_num-1,2
l = i-elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
mo_grad_lapl_beta(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
@ -1466,6 +1708,7 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1
enddo
i = elec_num
l = elec_num-elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
mo_grad_lapl_beta(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
@ -1475,9 +1718,9 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1
j = elec_beta_num
imo = mo_list_beta_curr(j)
!DIR$ LOOP COUNT (16)
do i=elec_alpha_num+1,elec_num
l = i-elec_alpha_num
!DIR$ VECTOR ALIGNED
do k=1,4
det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
mo_grad_lapl_beta(k,i,imo)*slater_matrix_beta_inv_det(l,j)