TREX/Sherman-Morrison
1
0
Fork 0
mirror of https://github.com/TREX-CoE/Sherman-Morrison.git synced 2024-09-28 04:21:06 +02:00
Code Issues Projects Releases Wiki Activity
f7dbe3ddd8
Sherman-Morrison/independent_test_harness/detupdate21.f90

109 lines
9.0 KiB
Fortran
Raw Normal View History

Added independent test harness, written in C. It has it's own Makefile and datasets. It is completely independent of the main tree.
2022-07-11 14:48:59 +02:00
subroutine detupd(vDim, vLDS, Updates, Updates_index, &
Slater_inv, determinant) bind(C)
use iso_c_binding
implicit none ! det.irp.f_template_577: 428
external :: det_update21
integer(c_int64_t), intent(in), value :: vLDS, vDim
real(c_double), intent(in) :: Updates(vLDS)
integer(c_int64_t), intent(in) :: Updates_index(1)
real(c_double), intent(inout) :: Slater_inv(vLDS,vDim)
real(c_double), intent(inout) :: determinant
integer(c_int64_t) :: l, n, LDS ! det.irp.f_template_577: 432
n = vDim
LDS = vLDS
l = Updates_index(1)
call det_update21(n, LDS, Updates, l, Slater_inv, determinant) ! det.irp.f_template_577: 427
end
subroutine det_update21(n, LDS, u, l, S_inv, d) ! det.irp.f_template_577: 427
use iso_c_binding
implicit none ! det.irp.f_template_577: 428
integer(c_int64_t), intent(in) :: l ! det.irp.f_template_577: 430
integer(c_int64_t), intent(in) :: n,LDS ! det.irp.f_template_577: 430
real(c_double),intent(inout) :: S_inv(LDS,n) ! det.irp.f_template_577: 435
real(c_double),intent(inout) :: d ! det.irp.f_template_577: 436
real(c_double), intent(in) :: u(n)
real(c_double) :: z(n), w(n), lambda, d_inv ! det.irp.f_template_577: 438
integer(c_int64_t) :: i,j ! det.irp.f_template_577: 444
real(c_double) :: zj, zj1, zj2, zj3 ! det.irp.f_template_577: 445
!DIR$ ATTRIBUTES ALIGN : 32 :: z, w ! det.irp.f_template_577: 439
!DIR$ ASSUME_ALIGNED u : 32 ! det.irp.f_template_577: 440
!DIR$ ASSUME_ALIGNED S_inv : 32 ! det.irp.f_template_577: 441
!DIR$ ASSUME (mod(LDS,32/8) == 0) ! det.irp.f_template_577: 442
!DIR$ ASSUME (LDS >= 21) ! det.irp.f_template_577: 443
zj = 0.d0 !! dot prod col S_inv and update: vT*S_inv*u ! det.irp.f_template_577: 451
!DIR$ NOPREFETCH ! det.irp.f_template_577: 452
do i=1,21-1,4 ! det.irp.f_template_577: 453
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3) ! det.irp.f_template_577: 454
enddo ! det.irp.f_template_577: 456
zj = zj + S_inv(21,l)*u(21) ! det.irp.f_template_577: 457
d_inv = 1.d0/d ! reciprocal of old det ! det.irp.f_template_577: 459
d = d+zj ! det.irp.f_template_577: 460
lambda = d*d_inv ! det.irp.f_template_577: 461
if (dabs(lambda) < 1.d-3) then ! det.irp.f_template_577: 462
! d = 0.d0 ! det.irp.f_template_577: 463
return ! det.irp.f_template_577: 464
endif ! det.irp.f_template_577: 465
!DIR$ VECTOR ALIGNED ! det.irp.f_template_577: 467
do j=1,21-1,4 ! det.irp.f_template_577: 468
zj = 0.d0 ! det.irp.f_template_577: 469
zj1 = 0.d0 ! det.irp.f_template_577: 470
zj2 = 0.d0 ! det.irp.f_template_577: 471
zj3 = 0.d0 ! det.irp.f_template_577: 472
!DIR$ VECTOR ALIGNED ! det.irp.f_template_577: 473
!DIR$ NOPREFETCH ! det.irp.f_template_577: 474
do i=1,21-1 ! det.irp.f_template_577: 475
zj = zj + S_inv(i,j )*u(i) ! det.irp.f_template_577: 476
zj1 = zj1 + S_inv(i,j+1)*u(i) ! det.irp.f_template_577: 477
zj2 = zj2 + S_inv(i,j+2)*u(i) ! det.irp.f_template_577: 478
zj3 = zj3 + S_inv(i,j+3)*u(i) ! det.irp.f_template_577: 479
enddo ! det.irp.f_template_577: 480
z(j ) = zj + S_inv(21,j )*u(21) ! det.irp.f_template_577: 481
z(j+1) = zj1 + S_inv(21,j+1)*u(21) ! det.irp.f_template_577: 482
z(j+2) = zj2 + S_inv(21,j+2)*u(21) ! det.irp.f_template_577: 483
z(j+3) = zj3 + S_inv(21,j+3)*u(21) ! det.irp.f_template_577: 484
enddo ! det.irp.f_template_577: 485
zj = 0.d0 ! det.irp.f_template_577: 487
!DIR$ VECTOR ALIGNED ! det.irp.f_template_577: 488
!DIR$ NOPREFETCH ! det.irp.f_template_577: 489
do i=1,21-1 ! det.irp.f_template_577: 490
zj = zj + S_inv(i,21)*u(i) ! det.irp.f_template_577: 491
enddo ! det.irp.f_template_577: 492
z(21) = zj + S_inv(21,21)*u(21) ! det.irp.f_template_577: 493
!DIR$ NOPREFETCH ! det.irp.f_template_577: 495
do i=1,21 ! det.irp.f_template_577: 496
w(i) = S_inv(i,l)*d_inv ! det.irp.f_template_577: 497
enddo ! det.irp.f_template_577: 499
do i=1,21-1,4 ! det.irp.f_template_577: 501
zj = z(i ) ! det.irp.f_template_577: 502
zj1 = z(i+1) ! det.irp.f_template_577: 503
zj2 = z(i+2) ! det.irp.f_template_577: 504
zj3 = z(i+3) ! det.irp.f_template_577: 505
!DIR$ VECTOR ALIGNED ! det.irp.f_template_577: 506
!DIR$ NOPREFETCH ! det.irp.f_template_577: 507
do j=1,21-1 ! det.irp.f_template_577: 508
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*zj ! det.irp.f_template_577: 509
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*zj1 ! det.irp.f_template_577: 510
S_inv(j,i+2) = S_inv(j,i+2)*lambda - w(j)*zj2 ! det.irp.f_template_577: 511
S_inv(j,i+3) = S_inv(j,i+3)*lambda - w(j)*zj3 ! det.irp.f_template_577: 512
enddo ! det.irp.f_template_577: 513
S_inv(21,i ) = S_inv(21,i )*lambda - w(21)*zj ! det.irp.f_template_577: 514
S_inv(21,i+1) = S_inv(21,i+1)*lambda - w(21)*zj1 ! det.irp.f_template_577: 515
S_inv(21,i+2) = S_inv(21,i+2)*lambda - w(21)*zj2 ! det.irp.f_template_577: 516
S_inv(21,i+3) = S_inv(21,i+3)*lambda - w(21)*zj3 ! det.irp.f_template_577: 517
enddo ! det.irp.f_template_577: 518
zj = z(21) ! det.irp.f_template_577: 520
!DIR$ VECTOR ALIGNED ! det.irp.f_template_577: 521
!DIR$ NOPREFETCH ! det.irp.f_template_577: 522
do i=1,21 ! det.irp.f_template_577: 523
S_inv(i,21) = S_inv(i,21)*lambda -w(i)*zj ! det.irp.f_template_577: 524
enddo ! det.irp.f_template_577: 525
end ! det.irp.f_template_577: 528
Reference in New Issue Copy Permalink