mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-11-07 14:43:41 +01:00
121 lines
2.9 KiB
FortranFixed
121 lines
2.9 KiB
FortranFixed
|
|
||
|
|
program invFSVD_spindet
|
||
|
|
|
||
|
|
BEGIN_DOC
|
||
|
|
! build CI matrix from SVD vectors
|
||
|
|
END_DOC
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
read_wf = .True.
|
||
|
|
TOUCH read_wf
|
||
|
|
|
||
|
|
call run()
|
||
|
|
|
||
|
|
end
|
||
|
|
|
||
|
|
|
||
|
|
subroutine run
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
integer :: mm, nn, i_state, low_rank
|
||
|
|
integer :: i, j, k, l
|
||
|
|
double precision :: tmp1, eps_det
|
||
|
|
double precision, allocatable :: U_SVD(:,:), D_SVD(:), V_SVD(:,:), A_SVD(:,:), US(:,:)
|
||
|
|
double precision, allocatable :: newpsi_rows(:), newpsi_columns(:), newpsi_values(:)
|
||
|
|
double precision :: t0, t1, t2
|
||
|
|
|
||
|
|
call CPU_TIME(t0)
|
||
|
|
|
||
|
|
i_state = 1
|
||
|
|
mm = n_det_alpha_unique
|
||
|
|
nn = n_det_beta_unique
|
||
|
|
print *, ' matrix dimensions:', mm,'x',nn
|
||
|
|
print *, ' N det:', N_det
|
||
|
|
|
||
|
|
call ezfio_get_spindeterminants_n_svd_coefs(low_rank)
|
||
|
|
print *, ' SVD rank:', low_rank
|
||
|
|
|
||
|
|
allocate( U_SVD(mm,low_rank), D_SVD(low_rank), V_SVD(nn,low_rank) )
|
||
|
|
call ezfio_get_spindeterminants_psi_svd_alpha(U_SVD)
|
||
|
|
call ezfio_get_spindeterminants_psi_svd_beta (V_SVD)
|
||
|
|
call ezfio_get_spindeterminants_psi_svd_coefs(D_SVD)
|
||
|
|
print *, ' read EZFIO SVD vectors OK'
|
||
|
|
|
||
|
|
! US = U x S :
|
||
|
|
allocate( US(mm,low_rank) )
|
||
|
|
US(:,:) = 0.d0
|
||
|
|
do i = 1, mm
|
||
|
|
do l = 1, low_rank
|
||
|
|
US(i,l) = U_SVD(i,l) * D_SVD(l)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
print *, ' U x D: ok'
|
||
|
|
deallocate( U_SVD , D_SVD )
|
||
|
|
|
||
|
|
! A_TSVD = US x V.T
|
||
|
|
allocate( A_SVD(mm,nn) )
|
||
|
|
A_SVD(:,:) = 0.d0
|
||
|
|
call dgemm( 'N', 'T', mm, nn, low_rank, 1.d0 &
|
||
|
|
, US , size(US ,1) &
|
||
|
|
, V_SVD , size(V_SVD,1) &
|
||
|
|
, 0.d0, A_SVD, size(A_SVD,1) )
|
||
|
|
print *, ' U x D x Vt: ok'
|
||
|
|
deallocatE(US)
|
||
|
|
|
||
|
|
call ezfio_set_spindeterminants_n_states(N_states)
|
||
|
|
call ezfio_set_spindeterminants_n_det_alpha(n_det_alpha_unique)
|
||
|
|
call ezfio_set_spindeterminants_n_det_beta(n_det_beta_unique)
|
||
|
|
|
||
|
|
print *, 'EZFIO set n_det_alpha and n_det_beta'
|
||
|
|
|
||
|
|
! ---------------
|
||
|
|
eps_det = 1d-15
|
||
|
|
print *, ' det coeff thresh for consideration =', eps_det
|
||
|
|
! ---------------
|
||
|
|
|
||
|
|
|
||
|
|
k = 0
|
||
|
|
do j = 1, nn
|
||
|
|
do i = 1, mm
|
||
|
|
tmp1 = A_SVD(i,j)
|
||
|
|
if( dabs(tmp1) .lt. (eps_det) ) cycle
|
||
|
|
k = k + 1
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
print *, ' non zero elements = ', k
|
||
|
|
|
||
|
|
allocate( newpsi_rows(k), newpsi_columns(k), newpsi_values(k) )
|
||
|
|
k = 0
|
||
|
|
do j = 1, nn
|
||
|
|
do i = 1, mm
|
||
|
|
tmp1 = A_SVD(i,j)
|
||
|
|
if( dabs(tmp1) .lt. (eps_det) ) cycle
|
||
|
|
k = k + 1
|
||
|
|
|
||
|
|
newpsi_rows (k) = i
|
||
|
|
newpsi_columns(k) = j
|
||
|
|
newpsi_values (k) = tmp1
|
||
|
|
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
|
||
|
|
call ezfio_set_spindeterminants_n_det(N_det)
|
||
|
|
call ezfio_set_spindeterminants_psi_coef_matrix_columns(psi_bilinear_matrix_columns)
|
||
|
|
call ezfio_set_spindeterminants_psi_coef_matrix_values(psi_bilinear_matrix_values)
|
||
|
|
call ezfio_set_spindeterminants_psi_coef_matrix_rows(psi_bilinear_matrix_rows)
|
||
|
|
|
||
|
|
|
||
|
|
deallocate( A_SVD )
|
||
|
|
deallocate( newpsi_rows, newpsi_columns, newpsi_values )
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
call CPU_TIME(t2)
|
||
|
|
print *, ''
|
||
|
|
print *, ' end after'
|
||
|
|
print *, (t2-t0)/60.d0, 'min'
|
||
|
|
|
||
|
|
end
|