1
0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-06-02 03:15:25 +02:00
qp_plugins_scemama/devel/svdwf/checkSVD_EZ.irp.f
2021-11-02 16:18:07 +01:00

107 lines
2.5 KiB
Fortran

program checkSVD_EZ
BEGIN_DOC
! save SVD manually
END_DOC
implicit none
read_wf = .True.
TOUCH read_wf
call run()
end
subroutine run
implicit none
integer :: mm, nn, i_state, low_rank, lrank_min, lrank_max
integer :: i, j, k, l
double precision :: norm_psi, err_verif, err_tmp
double precision, allocatable :: U_FSVD(:,:), D_FSVD(:), Vt_FSVD(:,:), V_FSVD(:,:), A_FSVD(:,:)
double precision, allocatable :: U_read(:,:), D_read(:), V_read(:,:)
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
allocate( A_FSVD(mm,nn), U_FSVD(mm,mm), D_FSVD(min(mm,nn)), Vt_FSVD(nn,nn) )
norm_psi = 0.d0
A_FSVD(:,:) = 0.d0
do k = 1, N_det
i = psi_bilinear_matrix_rows(k)
j = psi_bilinear_matrix_columns(k)
A_FSVD(i,j) = psi_bilinear_matrix_values(k,i_state)
norm_psi += psi_bilinear_matrix_values(k,i_state) * psi_bilinear_matrix_values(k,i_state)
enddo
call svd_s( A_FSVD, size(A_FSVD,1), U_FSVD, size(U_FSVD,1), D_FSVD, Vt_FSVD, size(Vt_FSVD,1), mm, nn)
print *, ' --- Full SVD: ok --- '
call CPU_TIME(t1)
print *, (t1-t0)/60.d0, 'min'
deallocate( A_FSVD )
allocate( V_FSVD(nn,nn) )
do i = 1, nn
do j = 1, nn
V_FSVD(i,j) = Vt_FSVD(j,i)
enddo
enddo
deallocate(Vt_FSVD)
! ------------------------------------------
allocate( U_read(mm,mm), D_read(min(mm,nn)), V_read(nn,nn) )
call ezfio_get_spindeterminants_psi_svd_coefs(D_read)
call ezfio_get_spindeterminants_psi_svd_alpha(U_read)
call ezfio_get_spindeterminants_psi_svd_beta (V_read)
err_verif = 0.d0
do i = 1, min(mm,nn)
err_tmp = D_FSVD(i) - D_read(i)
err_verif += err_tmp * err_tmp
enddo
print *, ' error on D:', err_verif
deallocate( D_FSVD, D_read )
err_verif = 0.d0
do j = 1, nn
do i = 1, mm
err_tmp = U_FSVD(i,j) - U_read(i,j)
err_verif = err_verif + err_tmp * err_tmp
enddo
enddo
print *, ' error on U:', err_verif
deallocate( U_FSVD, U_read )
err_verif = 0.d0
do j = 1, nn
do i = 1, mm
err_tmp = V_FSVD(i,j) - V_read(i,j)
err_verif = err_verif + err_tmp * err_tmp
enddo
enddo
print *, ' error on V:', err_verif
deallocate( V_FSVD, V_read )
call CPU_TIME(t2)
print *, ''
print *, ' end after'
print *, (t2-t0)/60.d0, 'min'
end