LCPQ/qmcchem
10
1
Fork 1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-11-07 06:33:38 +01:00
Code Releases Activity

Optimized det (mod1)

Browse Source
This commit is contained in:
Anthony Scemama 2016-06-03 15:05:17 +02:00
parent 5c872ed2aa
commit 56cd62957a
1 changed files with 23 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
src/det.irp.f
View File

@ -434,20 +434,20 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (mod(LDS,$IRP_ALIGN/8) == 0) !DIR$ ASSUME (mod(LDS,$IRP_ALIGN/8) == 0)
!DIR$ ASSUME (LDS >= $n) !DIR$ ASSUME (LDS >= $n)
integer :: i,j integer :: i,j
double precision :: zl, ui
!DIR$ VECTOR ALIGNED zl = 0.d0
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
z(l) = S_inv($n,l)*u($n)
!DIR$ VECTOR ALIGNED !DIR$ VECTOR ALIGNED
do i=1,$n-1 do i=1,$n-1
z(l) = z(l) + S_inv(i,l)*u(i) ui = m(i) - S(i,l)
u(i) = ui
zl = zl + S_inv(i,l)*ui
enddo enddo
u($n) = m($n) - S($n,l)
zl = zl + S_inv($n,l)*u($n)
d_inv = 1.d0/d d_inv = 1.d0/d
d = d+z(l) d = d+zl
lambda = d*d_inv lambda = d*d_inv
if (dabs(lambda) < 1.d-3) then if (dabs(lambda) < 1.d-3) then
d = 0.d0 d = 0.d0
@ -456,10 +456,10 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
!DIR$ VECTOR ALIGNED !DIR$ VECTOR ALIGNED
do j=1,$n-1,4 do j=1,$n-1,4
z(j ) = S_inv($n,j )*u($n) z(j ) = 0.d0
z(j+1) = S_inv($n,j+1)*u($n) z(j+1) = 0.d0
z(j+2) = S_inv($n,j+2)*u($n) z(j+2) = 0.d0
z(j+3) = S_inv($n,j+3)*u($n) z(j+3) = 0.d0
!DIR$ VECTOR ALIGNED !DIR$ VECTOR ALIGNED
do i=1,$n-1 do i=1,$n-1
z(j ) = z(j ) + S_inv(i,j )*u(i) z(j ) = z(j ) + S_inv(i,j )*u(i)
@ -467,11 +467,15 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
z(j+2) = z(j+2) + S_inv(i,j+2)*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+3) = z(j+3) + S_inv(i,j+3)*u(i)
enddo enddo
z(j ) = z(j ) + S_inv($n,j )*u($n)
z(j+1) = z(j+1) + S_inv($n,j+1)*u($n)
z(j+2) = z(j+2) + S_inv($n,j+2)*u($n)
z(j+3) = z(j+3) + S_inv($n,j+3)*u($n)
enddo enddo
z($n) = S_inv($n,$n)*u($n) z($n) = 0.d0
!DIR$ VECTOR ALIGNED !DIR$ VECTOR ALIGNED
do i=1,$n-1 do i=1,$n
z($n) = z($n) + S_inv(i,$n)*u(i) z($n) = z($n) + S_inv(i,$n)*u(i)
enddo enddo
!DIR$ VECTOR ALIGNED !DIR$ VECTOR ALIGNED
@ -488,14 +492,10 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
S_inv(j,i+2) = S_inv(j,i+2)*lambda - w(j)*z(i+2) S_inv(j,i+2) = S_inv(j,i+2)*lambda - w(j)*z(i+2)
S_inv(j,i+3) = S_inv(j,i+3)*lambda - w(j)*z(i+3) S_inv(j,i+3) = S_inv(j,i+3)*lambda - w(j)*z(i+3)
enddo enddo
enddo 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)
!DIR$ VECTOR ALIGNED S_inv($n,i+2) = S_inv($n,i+2)*lambda - w($n)*z(i+2)
do i=1,$n-1,4 S_inv($n,i+3) = S_inv($n,i+3)*lambda - w($n)*z(i+3)
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)
S_inv($n,i+2) = S_inv($n,i+2)*lambda - w($n)*z(i+2)
S_inv($n,i+3) = S_inv($n,i+3)*lambda - w($n)*z(i+3)
enddo enddo
!DIR$ VECTOR ALIGNED !DIR$ VECTOR ALIGNED