program saveSVD_asEZ 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(:,:), A_FSVD(:,:) double precision, allocatable :: Uezfio(:,:,:), Dezfio(:,:), Vezfio(:,:,:) double precision, allocatable :: US(:,:), A_TSVD(:,:) 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' ! ------------------------------------------ !low_rank = 24 low_rank = min(mm,nn) ! US = U x SV : allocate( US(mm,low_rank) ) US(:,:) = 0.d0 do i = 1, mm do l = 1, low_rank US(i,l) = U_FSVD(i,l) * D_FSVD(l) enddo enddo ! A_TSVD = US x Vt_FSVD allocate( A_TSVD(mm,nn) ) A_TSVD(:,:) = 0.d0 call dgemm( 'N', 'N', mm, nn, low_rank, 1.d0 & , US , size(US ,1) & , Vt_FSVD, size(Vt_FSVD,1) & , 0.d0, A_TSVD, size(A_TSVD,1) ) deallocatE(US) ! |A_FSVD-A_TSVD| err_verif = 0.d0 do j = 1, nn do i = 1, mm err_tmp = A_FSVD(i,j) - A_TSVD(i,j) err_verif = err_verif + err_tmp * err_tmp enddo enddo print*, ' rank = ', low_rank print*, ' err verif (%) = ', 100.d0 * dsqrt(err_verif/norm_psi) deallocate( A_FSVD , A_TSVD ) ! ------------------------------------------------------------------------------------------------ ! set to EZFIO for a fixed low rank allocate( Uezfio(mm,low_rank,1), Dezfio(low_rank,1), Vezfio(nn,low_rank,1)) do l = 1, low_rank Dezfio(l,1) = D_FSVD(l) do j = 1, mm Uezfio(j,l,1) = U_FSVD(j,l) enddo do j = 1, nn Vezfio(j,l,1) = Vt_FSVD(l,j) enddo enddo deallocate( U_FSVD, D_FSVD, Vt_FSVD ) !call ezfio_set_spindeterminants_n_det(N_det) !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) !call ezfio_set_spindeterminants_psi_coef_matrix_rows(psi_bilinear_matrix_rows) !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_n_svd_coefs(low_rank) call ezfio_set_spindeterminants_psi_svd_coefs(Dezfio) deallocate( Dezfio) ! does not work for big matrices !call ezfio_set_spindeterminants_psi_svd_alpha(Uezfio) !call ezfio_set_spindeterminants_psi_svd_beta(Vezfio ) open(unit=11, file="u_svd.txt", action='write') do l = 1, low_rank do i = 1, mm write(11,*) Uezfio(i,l,1) enddo enddo close(11) deallocate( Uezfio ) open(unit=11, file="v_svd.txt", action='write') do l = 1, low_rank do i = 1, nn write(11,*) Vezfio(i,l,1) enddo enddo close(11) deallocate( Vezfio ) ! ------------------------------------------------------------------------------------------------ call CPU_TIME(t2) print *, '' print *, ' end after' print *, (t2-t0)/60.d0, 'min' end